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 s