Automated Reasoning for Mizar

:: AIM Loops and the AIM Conjecture
::  by Chad E. Brown, Karol P\kak

:: Most material from Kinyon, Veroff, Vojtechovsky 2013
:: or Veroff's Prover9 files
:: and
:: Albert, A. A. (1943), "Quasigroups. I.",
:: Trans. Amer. Math. Soc., 54: 507-519,

:: initial environ copied from MONOID_0
environ

vocabularies STRUCT_0, ALGSTR_0, BINOP_1, SUBSET_1,
      SETFAM_1, ABIAN, KNASTER, FUNCT_1, FINSEQ_1,
      RELAT_1, ORDINAL4, XBOOLE_0, ALGSTR_1, SETWISEO, FUNCOP_1, ZFMISC_1,
      GROUP_1, GROUP_2, GROUP_6, GROUP_9, FINSEQOP, MESFUNC1, VECTSP_1, TARSKI, REALSET1,
      MCART_1, COHSP_1, AMISTD_1,
      NUMBERS, BINOP_2, REAL_1, ARYTM_3, CARD_1, GR_CY_1, INT_1, PARTFUN1,
      FUNCT_2, MONOID_0, ALG_1, PRE_TOPC, QC_LANG1, AIMLOOP0;
 notations TARSKI, XBOOLE_0, ZFMISC_1, SUBSET_1, ORDINAL1, NUMBERS,
      XCMPLX_0, XREAL_0, XTUPLE_0, MCART_1, DOMAIN_1, BINOP_2,
      REALSET1, RELAT_1, FINSEQOP, FUNCT_1, FINSEQ_1, PARTFUN1, FUNCT_2,
      BINOP_1, FINSEQ_2, INT_1, STRUCT_0, ALGSTR_0, ALGSTR_1,
      GROUP_1, VECTSP_1, SETWISEO, FUNCOP_1, GR_CY_1, COHSP_1,
      ABIAN, KNASTER, TRANSGEO;
 constructors RELAT_2, PARTFUN1, BINOP_1, SETWISEO, BINOP_2, ALGSTR_1,
      FINSEQOP, REALSET1, VECTSP_2, GR_CY_1, RELSET_1, XTUPLE_0, NUMBERS,
      ABIAN,
      KNASTER, COHSP_1, TRANSGEO;
 registrations XBOOLE_0, SUBSET_1, RELAT_1, FUNCT_1, KNASTER,
      ORDINAL1, PARTFUN1,
      FUNCT_2, NUMBERS, BINOP_2, MEMBERED, FINSEQ_1, REALSET1, STRUCT_0,
      GROUP_1, ALGSTR_0, ALGSTR_1, GR_CY_1, XREAL_0, NAT_1, MONOID_0,
      VECTSP_1,RELSET_1, COHSP_1;
 requirements NUMERALS, BOOLE, SUBSET, ARITHM;
 definitions TARSKI, BINOP_1, ABIAN, 
      SETWISEO, FINSEQOP, GROUP_1, STRUCT_0, XBOOLE_0,COHSP_1,
      ALGSTR_0,ALGSTR_1,VECTSP_1, MONOID_0;
 equalities XBOOLE_0, BINOP_1, STRUCT_0, REALSET1, ALGSTR_0, FUNCOP_1, VECTSP_1;
 expansions XBOOLE_0, TARSKI, BINOP_1, FINSEQOP, GROUP_1, VECTSP_1, TRANSGEO;
 theorems TARSKI, XBOOLE_0, XBOOLE_1, SUBSET, SUBSET_1, SETFAM_1, KNASTER,
      NAT_1, INT_1, FINSEQ_1, BINOP_1, GROUP_1, SETWISEO, MCART_1,
      ZFMISC_1, FUNCT_1, FUNCT_2, FUNCT_4, FUNCOP_1, PARTFUN1, GR_CY_1,
      GRFUNC_1, RELAT_1, RELSET_1, XCMPLX_1, NUMBERS, BINOP_2, ORDINAL1,
      MONOID_0, ALGSTR_0, ALGSTR_1, VECTSP_1, REALSET1, ABIAN, RING_3,
      SYSREL, FUNCT_5;
 schemes  KNASTER, FUNCT_2, FUNCT_7, BINOP_1, XBOOLE_0, SUBSET_1;

vocabularies  FUNCT_4,  FUNCT_5;
 notations  WELLORD2,  FUNCT_3, CARD_1,  FUNCT_4,FUNCT_5;
 constructors  WELLORD2,  FUNCT_3, FUNCOP_1, FUNCT_4, CARD_1,
     DOMAIN_1, FUNCT_5;
 registrations  FUNCT_5, FUNCOP_1;

begin :: Updating

reserve Q,Q1,Q2 for multLoop;
reserve x,y,z,w,u,v for Element of Q;

:::$V-
:::$P-

theorem lid: 1.Q * x = x
proof
  1.Q is_a_unity_wrt the multF of Q by MONOID_0:def 21;
  then 1.Q is_a_left_unity_wrt the multF of Q;
  hence thesis;
end;

theorem rid: x * 1.Q = x
proof
  1.Q is_a_unity_wrt the multF of Q by MONOID_0:def 21;
  then 1.Q is_a_right_unity_wrt the multF of Q;
  hence thesis;
end;

theorem Th0e:
  ex z being Element of Q st x * z = y
proof
  thus thesis by ALGSTR_1:def 6;
end;

definition
  let Q be invertible left_mult-cancelable non empty multLoopStr, x,y be Element of Q;
  func x \ y -> Element of Q means
  :Def1:
  x * it = y;
  existence by ALGSTR_1:def 6;
  uniqueness
  proof
    let z be Element of Q;
    let w be Element of Q;
    assume A1: x * z = y;
    assume A2: x * w = y;
    A3: x * z = x * w by A1,A2;
    x is left_mult-cancelable;
    hence thesis by A3,ALGSTR_0:def 20;
  end;
end;

definition
  let Q be invertible right_mult-cancelable non empty multLoopStr, x,y be Element of Q;
  func x / y -> Element of Q means
  :Def2:
  it * y = x;
  existence by ALGSTR_1:def 6;
  uniqueness
  proof
    let z be Element of Q;
    let w be Element of Q;
    assume A1: z * y = x;
    assume A2: w * y = x;
    A3: z * y = w * y by A1,A2;
    x is right_mult-cancelable;
    hence thesis by A3,ALGSTR_0:def 21;
  end;
end;

registration
  let Q;
  let x;
  reduce 1.Q * x to x;
  reducibility by lid;
  reduce x * 1.Q to x;
  reducibility by rid;
  let y;
  reduce x \ (x * y) to y;
  reducibility by Def1;
  reduce x * (x \ y) to y;
  reducibility by Def1;
  reduce (x * y) / y to x;
  reducibility by Def2;
  reduce (x / y) * y to x;
  reducibility by Def2;
end;

definition
  let Q be invertible left_mult-cancelable non empty multLoopStr, u,x be Element of Q;
  func T(u,x) -> Element of Q equals
  :DefT:
  x \ (u * x);
  coherence;
end;

definition
  let Q be invertible left_mult-cancelable non empty multLoopStr, u,x,y be Element of Q;
  func L(u,x,y) -> Element of Q equals
  :DefL:
  (y * x) \ (y * (x * u));
  coherence;
end;

definition
  let Q be invertible right_mult-cancelable non empty multLoopStr, u,x,y be Element of Q;
  func R(u,x,y) -> Element of Q equals
  :DefR:
  ((u * x) * y) / (x * y);
  coherence;
end;

definition
  let Q;
  attr Q is TT means for u,x,y be Element of Q holds T(T(u,x),y) = T(T(u,y),x);
  attr Q is TL means for u,x,y,z be Element of Q holds T(L(u,x,y),z) = L(T(u,z),x,y);
  attr Q is TR means for u,x,y,z be Element of Q holds T(R(u,x,y),z) = R(T(u,z),x,y);
  attr Q is LR means for u,x,y,z,w be Element of Q holds L(R(u,x,y),z,w) = R(L(u,z,w),x,y);
  attr Q is LL means for u,x,y,z,w be Element of Q holds L(L(u,x,y),z,w) = L(L(u,z,w),x,y);
  attr Q is RR means for u,x,y,z,w be Element of Q holds R(R(u,x,y),z,w) = R(R(u,z,w),x,y);
end;

definition
  let Q; let x,y;
  func K(x,y) -> Element of Q equals
  :DefK:
  (y * x) \ (x * y);
  coherence;
end;

definition
  let Q; let x,y,z;
  func a(x,y,z) -> Element of Q equals
  :Defa:
  (x * (y * z)) \ ((x * y) * z);
  coherence;
end;

definition
  let Q be multLoop;
  attr Q is aa1 means :Defaa1: for x,y,z,u,w be Element of Q holds a(a(x,y,z),u,w) = 1.Q;
  attr Q is aa2 means :Defaa2: for x,y,z,u,w be Element of Q holds a(x,a(y,z,u),w) = 1.Q;
  attr Q is aa3 means :Defaa3: for x,y,z,u,w be Element of Q holds a(x,y,a(z,u,w)) = 1.Q;
  attr Q is Ka means :DefKa: for x,y,z,u be Element of Q holds K(a(x,y,z),u) = 1.Q;
  attr Q is aK1 means :DefaK1: for x,y,z,u be Element of Q holds a(K(x,y),z,u) = 1.Q;
  attr Q is aK2 means :DefaK2: for x,y,z,u be Element of Q holds a(x,K(y,z),u) = 1.Q;
  attr Q is aK3 means :DefaK3: for x,y,z,u be Element of Q holds a(x,y,K(z,u)) = 1.Q;
end;

registration
  cluster strict TT TL TR LR LL RR aa1 aa2 aa3 Ka aK1 aK2 aK3 for multLoop;
  existence
  proof
    Trivial-multLoopStr is TT TL TR LR LL RR aa1 aa2 aa3 Ka aK1 aK2 aK3 by ALGSTR_1:9;
    hence thesis;
  end;
end;

definition
  mode FOAIMLoop is TT TL TR LR LL RR multLoop;
  let Q be multLoop;
  attr Q is FOAIMConjEqs means Q is aa1 aa2 aa3 Ka aK1 aK2 aK3;
end;

:: One formulation of the AIM Conjecture states:
:: theorem for Q be FOAIMLoop holds Q is FOAIMConjEqs;

theorem pos:
  x * y = z implies z / y = x;

theorem pob:
  x * y = z implies x \ z = y;

theorem pso:
  z / y = x implies x * y = z;

theorem psb:
  z / y = x implies x \ z = y
  proof
    assume z / y = x;
    then x * y = z;
    hence x \ z = y;
  end;

theorem pbo:
  x \ z = y implies x * y = z;

theorem pbs:
  x \ z = y implies z / y = x
  proof
    assume x \ z = y;
    then x * y = z;
    hence thesis;
  end;

theorem co3:
  for Q be multLoop, x,y,z be Element of Q holds
  x * y = x * z implies y = z
  proof
    let Q be multLoop, x,y,z be Element of Q;
    assume H: x * y = x * z;
    then y = x \ (x * z) by H
    .= z;
    hence thesis;
  end;

theorem co4:
  for Q be multLoop, x,y,z be Element of Q holds
  y * x = z * x implies y = z
  proof
    let Q be multLoop, x,y,z be Element of Q;
    assume y * x = z * x;
    then
    y = (z * x) / x
    .= z;
    hence thesis;
  end;

registration
  let Q;
  let x;
  reduce 1.Q \ x to x;
  reducibility
  proof
    1.Q * x = x;
    hence thesis;
  end;
  reduce x / 1.Q to x;
  reducibility
  proof
    x * 1.Q = x;
    hence thesis;
  end;
  let y;
  reduce y / (x \ y) to x;
  reducibility
  proof
    x * (x \ y) = y;
    hence thesis;
  end;
  reduce (y / x) \ y to x;
  reducibility
  proof
    (y / x) * x = y;
    hence thesis;
  end;
end;

theorem id5:
  x \ x = 1.Q
  proof
    x * 1.Q = x;
    hence thesis;
  end;

theorem id6:
  x / x = 1.Q
  proof
    1.Q * x = x;
    hence thesis;
  end;
  
theorem bid:
  x \ y = 1.Q implies x = y
  proof
    assume x \ y = 1.Q;
    then x * 1.Q = y;
    hence thesis;
  end;

theorem sid:
  for Q be multLoop, x,y be Element of Q holds
  x / y = 1.Q implies x = y
  proof
    let Q be multLoop, x,y be Element of Q;
    assume x / y = 1.Q;
    then 1.Q * y = x;
    hence x = y;
  end;

theorem aeassoc:
  a(x,y,z) = 1.Q implies (x*(y*z)) = ((x*y)*z)
proof
  assume a(x,y,z) = 1.Q;
  then (x*(y*z)) * 1.Q = ((x*y)*z) by Defa;
  hence thesis;
end;

theorem Kecomm:
  K(x,y) = 1.Q implies x*y = y*x
proof
  assume K(x,y) = 1.Q;
  then (y*x) * 1.Q = (x*y) by DefK;
  hence thesis;
end;

theorem comp1:
  a(x,y,z) = 1.Q implies L(z,y,x) = z
proof
  assume a(x,y,z) = 1.Q;
  then L(z,y,x) = (x*y) \ ((x*y)*z) by DefL,aeassoc;
  hence thesis;
end;

definition
  let Q;
  defpred P1[Element of Q] means for y,z holds ($1 * y) * z = $1 * (y * z);
  defpred P2[Element of Q] means for x,z holds (x * $1) * z = x * ($1 * z);
  defpred P3[Element of Q] means for x,y holds (x * y) * $1 = x * (y * $1);
  defpred PC[Element of Q] means for y holds $1 * y = y * $1;
  func Nucl_l Q -> Subset of Q means
  :DefNucll:
  x in it iff for y,z holds (x * y) * z = x * (y * z);
  existence
  proof
    set N = {x : P1[x]};
    N c= the carrier of Q
    proof
      let x be object;
      assume x in N;
      then ex x1 be Element of Q st x = x1 & P1[x1];
      hence thesis;
    end;
    then reconsider N as Subset of Q;
    take N;
    let x;
    x in N implies P1[x]
    proof
      assume x in N;
      then consider x1 be Element of Q such that
      A1: x = x1 & P1[x1];
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let X1,X2 be Subset of Q;
    assume HX1: for x being Element of Q holds x in X1 iff P1[x];
    assume HX2: for x being Element of Q holds x in X2 iff P1[x];
    thus thesis from SUBSET_1:sch 2(HX1,HX2);
  end;
  func Nucl_m Q -> Subset of Q means
  :DefNuclm:
  y in it iff for x,z holds (x * y) * z = x * (y * z);
  existence
  proof
    set N = {x : P2[x]};
    N c= the carrier of Q
    proof
      let x be object;
      assume x in N;
      then ex x1 be Element of Q st x = x1 & P2[x1];
      hence thesis;
    end;
    then reconsider N as Subset of Q;
    take N;
    let x;
    x in N implies P2[x]
    proof
      assume x in N;
      then consider x1 be Element of Q such that
      A1: x = x1 & P2[x1];
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let X1,X2 be Subset of Q;
    assume HX1: for x being Element of Q holds x in X1 iff P2[x];
    assume HX2: for x being Element of Q holds x in X2 iff P2[x];
    thus thesis from SUBSET_1:sch 2(HX1,HX2);
  end;
  func Nucl_r Q -> Subset of Q means
  :DefNuclr:
  z in it iff for x,y holds (x * y) * z = x * (y * z);
  existence
  proof
    set N = {x : P3[x]};
    N c= the carrier of Q
    proof
      let x be object;
      assume x in N;
      then ex x1 be Element of Q st x = x1 & P3[x1];
      hence thesis;
    end;
    then reconsider N as Subset of Q;
    take N;
    let x;
    x in N implies P3[x]
    proof
      assume x in N;
      then consider x1 be Element of Q such that
      A1: x = x1 & P3[x1];
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let X1,X2 be Subset of Q;
    assume HX1: for x being Element of Q holds x in X1 iff P3[x];
    assume HX2: for x being Element of Q holds x in X2 iff P3[x];
    thus thesis from SUBSET_1:sch 2(HX1,HX2);
  end;
  func Comm Q -> Subset of Q means
  :DefComm:
  x in it iff for y holds x * y = y * x;
  existence
  proof
    set N = {x : PC[x]};
    N c= the carrier of Q
    proof
      let x be object;
      assume x in N;
      then ex x1 be Element of Q st x = x1 & PC[x1];
      hence thesis;
    end;
    then reconsider N as Subset of Q;
    take N;
    let x;
    x in N implies PC[x]
    proof
      assume x in N;
      then consider x1 be Element of Q such that
      A1: x = x1 & PC[x1];
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let X1,X2 be Subset of Q;
    assume HX1: for x being Element of Q holds x in X1 iff PC[x];
    assume HX2: for x being Element of Q holds x in X2 iff PC[x];
    thus thesis from SUBSET_1:sch 2(HX1,HX2);
  end;
end;

definition
  let Q;
  func Nucl Q -> Subset of Q equals
  :DefNucl:
  Nucl_l Q /\ Nucl_m Q /\ Nucl_r Q;
  coherence;
end;

definition
  let Q;
  func Cent Q -> Subset of Q equals
  :DefCent:
  Comm Q /\ Nucl Q;
  coherence;
end;

definition
  let Q1, Q2 be multLoop;
  let f be Function of Q1,Q2;
  attr f is homomorphic means
  :Defhom:
  f.(1.Q1) = 1.Q2 & for x,y being Element of Q1 holds f.(x * y) = (f.x) * (f.y);
end;

registration
  let Q1,Q2 be multLoop;
  cluster homomorphic for Function of Q1,Q2;
  existence
  proof
    deffunc F(Element of Q1) = 1.Q2;
    consider f be Function of Q1,Q2
    such that
    H1: for x being Element of Q1 holds f.x = F(x)
    from FUNCT_2:sch 4;
    take f;
    thus f.(1.Q1) = 1.Q2 by H1;
    let x,y be Element of Q1;
    1.Q2 * 1.Q2 = 1.Q2;
    hence f.(x * y) = 1.Q2 * 1.Q2 by H1
    .= (f.x) * 1.Q2 by H1
    .= (f.x) * (f.y) by H1;
  end;
end;

definition
  let Q,Q2;
  let f be homomorphic Function of Q,Q2;
  func Ker f -> Subset of Q means
  :DefKer:
  x in it iff f.x = 1.Q2;
  existence
  proof
    set N = {x : f.x = 1.Q2};
    N c= the carrier of Q
    proof
      let x be object;
      assume x in N;
      then ex x1 be Element of Q st x = x1 & f.x1 = 1.Q2;
      hence thesis;
    end;
    then reconsider N as Subset of Q;
    take N;
    x in N implies f.x = 1.Q2
    proof
      assume x in N;
      then consider x1 be Element of Q such that
      A1: x = x1 & f.x1 = 1.Q2;
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let X1,X2 be Subset of Q;
    assume HX1: for x being Element of Q holds x in X1 iff f.x = 1.Q2;
    assume HX2: for x being Element of Q holds x in X2 iff f.x = 1.Q2;
    now
      let x be Element of Q;
      x in X1 iff f.x = 1.Q2 by HX1;
      hence x in X1 iff x in X2 by HX2;
    end;
    hence thesis by SUBSET_1:3;
  end;
end;

theorem loopHomBackslash:
  for Q1 be multLoop holds
  for Q2 be multLoop holds
  for f being homomorphic Function of Q1,Q2 holds
  for x,y being Element of Q1 holds f.(x \ y) = f.x \ f.y
proof
  let Q1,Q2 be multLoop;
  let f be homomorphic Function of Q1,Q2;
  let x,y be Element of Q1;
  f.x * f.(x \ y) = f.(x * (x \ y)) by Defhom;
  hence thesis;
end;

theorem loopHomSlash:
  for Q1 be multLoop holds
  for Q2 be multLoop holds
  for f being homomorphic Function of Q1,Q2 holds
  for x,y being Element of Q1 holds f.(x / y) = f.x / f.y
proof
  let Q1,Q2 be multLoop;
  let f be homomorphic Function of Q1,Q2;
  let x,y be Element of Q1;
  f.(x / y) * f.y = f.((x / y) * y) by Defhom;
  hence thesis;
end;

theorem Assoclem:
  for Q1 be multLoop holds
  for Q2 be multLoop holds
  for f being homomorphic Function of Q1,Q2 st
  (for y be Element of Q2 holds ex x being Element of Q1 st f.x = y)
  &
  (for x,y,z be Element of Q1 holds a(x,y,z) in Ker f)
  holds
  Q2 is associative
proof
  let Q1 be multLoop;
  let Q2 be multLoop;
  let f be homomorphic Function of Q1,Q2;
  assume that B: for y be Element of Q2 holds ex x being Element of Q1 st f.x = y
  and C: for x,y,z be Element of Q1 holds a(x,y,z) in Ker f;
  A1: f.(1.Q1) = 1.Q2 by Defhom;
  A2: for u,v be Element of Q1 holds f.(u * v) = f.u * f.v by Defhom;
  thus Q2 is associative
  proof
    let x,y,z be Element of Q2;
    consider x1 being Element of Q1 such that Hx: f.x1 = x by B;
    consider y1 being Element of Q1 such that Hy: f.y1 = y by B;
    consider z1 being Element of Q1 such that Hz: f.z1 = z by B;
    C2: a(x1,y1,z1) in Ker f by C;
    a(x,y,z) = 1.Q2
    proof
      a(x,y,z) = (x*(y*z)) \ ((x*y)*z) by Defa
      .= (f.x1 * (f.y1 * f.z1)) \ ((f.x1 * f.y1) * f.z1) by Hx,Hy,Hz
      .= (f.x1 * f.(y1 * z1)) \ ((f.x1 * f.y1) * f.z1) by A2
      .= f.(x1 * (y1 * z1)) \ ((f.x1 * f.y1) * f.z1) by A2
      .= f.(x1 * (y1 * z1)) \ (f.(x1 * y1) * f.z1) by A2
      .= f.(x1 * (y1 * z1)) \ f.((x1 * y1) * z1) by A2
      .= f.((x1 * (y1 * z1)) \ ((x1 * y1) * z1)) by loopHomBackslash
      .= f.(a(x1,y1,z1)) by Defa
      .= 1.Q2 by C2, DefKer;
      hence thesis;
    end;
    hence thesis by aeassoc;
  end;
end;

theorem FOAIMConjEqsImpAimConj1:
  for Q1 be aa1 aa2 aa3 aK1 aK2 aK3 multLoop holds
  for Q2 be multLoop holds
  for f being homomorphic Function of Q1,Q2 st
  (for y be Element of Q2 holds ex x being Element of Q1 st f.x = y)
  &
  Nucl Q1 c= Ker f
  holds
  Q2 is commutative multGroup
proof
  let Q1 be aa1 aa2 aa3 aK1 aK2 aK3 multLoop;
  let Q2 be multLoop;
  let f be homomorphic Function of Q1,Q2;
  assume that B: for y be Element of Q2 holds ex x being Element of Q1 st f.x = y
  and C: Nucl Q1 c= Ker f;
  A1: f.(1.Q1) = 1.Q2 by Defhom;
  A2: for u,v be Element of Q1 holds f.(u * v) = f.u * f.v by Defhom;
  TTT: Q2 is commutative
  proof
    let x,y be Element of Q2;
    consider x1 being Element of Q1 such that Hx: f.x1 = x by B;
    consider y1 being Element of Q1 such that Hy: f.y1 = y by B;
    K(x,y) = 1.Q2
    proof
      HK2: K(x1,y1) in Ker f
      proof
        HK2n: K(x1,y1) in Nucl Q1
        proof
          now
            let u,w be Element of Q1;
            a(K(x1,y1),u,w) = 1.Q1 by DefaK1;
            hence K(x1,y1) * (u * w) = (K(x1,y1) * u) * w by aeassoc;
          end;
          then HK2l: K(x1,y1) in Nucl_l Q1 by DefNucll;
          now
            let u,w be Element of Q1;
            a(u,K(x1,y1),w) = 1.Q1 by DefaK2;
            hence u * (K(x1,y1) * w) = (u * K(x1,y1)) * w by aeassoc;
          end;
          then HK2m: K(x1,y1) in Nucl_m Q1 by DefNuclm;
          now
            let u,w be Element of Q1;
            a(u,w,K(x1,y1)) = 1.Q1 by DefaK3;
            hence u * (w * K(x1,y1)) = (u * w) * K(x1,y1) by aeassoc;
          end;
          then HK2r: K(x1,y1) in Nucl_r Q1 by DefNuclr;
          K(x1,y1) in Nucl_l Q1 /\ Nucl_m Q1 by HK2l,HK2m, XBOOLE_0:def 4;
          hence thesis by HK2r, DefNucl, XBOOLE_0:def 4;
        end;
        thus thesis by HK2n, C;
      end;
      K(x,y) = (y*x) \ (x*y) by DefK
      .= (f.y1 * f.x1) \ (f.x1 * f.y1) by Hx,Hy
      .= f.(y1 * x1) \ (f.x1 * f.y1) by A2
      .= f.(y1 * x1) \ f.(x1 * y1) by A2
      .= f.((y1 * x1) \ (x1 * y1)) by loopHomBackslash
      .= f.(K(x1,y1)) by DefK
      .= 1.Q2 by HK2, DefKer;
      hence thesis;
    end;
    hence thesis by Kecomm;
  end;
  now
    let x1,y1,z1 be Element of Q1;
    a(x1,y1,z1) in Nucl Q1
    proof
      now
        let u,w be Element of Q1;
        a(a(x1,y1,z1),u,w) = 1.Q1 by Defaa1;
        hence (a(x1,y1,z1) * u) * w = a(x1,y1,z1) * (u * w) by aeassoc;
      end;
      then HK1l: a(x1,y1,z1) in Nucl_l Q1 by DefNucll;
      now
        let u,w be Element of Q1;
        a(u,a(x1,y1,z1),w) = 1.Q1 by Defaa2;
        hence (u * a(x1,y1,z1)) * w = u * (a(x1,y1,z1) * w) by aeassoc;
      end;
      then HK1m: a(x1,y1,z1) in Nucl_m Q1 by DefNuclm;
      now
        let u,w be Element of Q1;
        a(u,w,a(x1,y1,z1)) = 1.Q1 by Defaa3;
        hence (u * w) * a(x1,y1,z1) = u * (w * a(x1,y1,z1)) by aeassoc;
      end;
      then HK1r: a(x1,y1,z1) in Nucl_r Q1 by DefNuclr;
      a(x1,y1,z1) in Nucl_l Q1 /\ Nucl_m Q1 by HK1l,HK1m, XBOOLE_0:def 4;
      hence thesis by HK1r, DefNucl, XBOOLE_0:def 4;
    end;
    hence a(x1,y1,z1) in Ker f by C;
  end;
  hence thesis by TTT,Assoclem,Defhom,B;
end;

theorem FOAIMConjEqsImpAimConj2:
  for Q1 be aa1 aa2 aa3 Ka multLoop holds
  for Q2 be multLoop holds
  for f being homomorphic Function of Q1,Q2 st
  (for y be Element of Q2 holds ex x being Element of Q1 st f.x = y)
  &
  Cent Q1 c= Ker f
  holds
  Q2 is multGroup
proof
  let Q1 be aa1 aa2 aa3 Ka multLoop;
  let Q2 be multLoop;
  let f be homomorphic Function of Q1,Q2;
  assume that B: for y be Element of Q2 holds ex x being Element of Q1 st f.x = y
  and C: Cent Q1 c= Ker f;
  A1: f.(1.Q1) = 1.Q2 by Defhom;
  A2: for u,v be Element of Q1 holds f.(u * v) = f.u * f.v by Defhom;
  Cent Q1 c= Nucl Q1 by DefCent, XBOOLE_1:17;
  now
    let x1,y1,z1 be Element of Q1;
    a(x1,y1,z1) in Cent Q1
    proof
      now
        let u be Element of Q1;
        K(a(x1,y1,z1),u) = 1.Q1 by DefKa;
        hence a(x1,y1,z1) * u = u * a(x1,y1,z1) by Kecomm;
      end;
      then HK1c: a(x1,y1,z1) in Comm Q1 by DefComm;
      now
        let u,w be Element of Q1;
        a(a(x1,y1,z1),u,w) = 1.Q1 by Defaa1;
        hence (a(x1,y1,z1) * u) * w = a(x1,y1,z1) * (u * w) by aeassoc;
      end;
      then HK1l: a(x1,y1,z1) in Nucl_l Q1 by DefNucll;
      now
        let u,w be Element of Q1;
        a(u,a(x1,y1,z1),w) = 1.Q1 by Defaa2;
        hence (u * a(x1,y1,z1)) * w = u * (a(x1,y1,z1) * w) by aeassoc;
      end;
      then HK1m: a(x1,y1,z1) in Nucl_m Q1 by DefNuclm;
      now
        let u,w be Element of Q1;
        a(u,w,a(x1,y1,z1)) = 1.Q1 by Defaa3;
        hence (u * w) * a(x1,y1,z1) = u * (w * a(x1,y1,z1)) by aeassoc;
      end;
      then HK1r: a(x1,y1,z1) in Nucl_r Q1 by DefNuclr;
      a(x1,y1,z1) in Nucl_l Q1 /\ Nucl_m Q1 by HK1l,HK1m, XBOOLE_0:def 4;
      then a(x1,y1,z1) in Nucl Q1 by HK1r, DefNucl, XBOOLE_0:def 4;
      hence thesis by HK1c, DefCent, XBOOLE_0:def 4;
    end;
    hence a(x1,y1,z1) in Ker f by C;
  end;
  hence thesis by Assoclem,B;
end;

:: following GROUP_2
definition
  let Q be non empty multLoopStr;
  mode SubLoopStr of Q -> non empty multLoopStr means :SubL:
  the carrier of it c= the carrier of Q &
  the multF of it = (the multF of Q)||the carrier of it &
  the OneF of it = the OneF of Q;
  existence
  proof
    take Q;
    thus thesis;
  end;
end;

registration
  let Q be multLoop;
  cluster well-unital invertible cancelable strict for SubLoopStr of Q;
  existence
  proof
    reconsider Q1=the multLoopStr of Q as non empty multLoopStr;
    R1: the multF of Q1 = (the multF of Q)||the carrier of Q1;
    R2: the OneF of Q1 = the OneF of Q;
    then reconsider Q1 as SubLoopStr of Q by R1,R2,SubL;
    take Q1;
      now
          let x be Element of Q1;
          reconsider x1=x as Element of Q;
           x*1.Q1 = x1*1.Q & 1.Q1*x = 1.Q*x1;
          hence x * 1. Q1 = x & 1.Q1 * x = x by VECTSP_1:def 6;
      end;
    hence Q1 is well-unital by VECTSP_1:def 6;
    thus Q1 is invertible
      proof
         hereby let x,y be Element of Q1;
           reconsider x1=x as Element of Q;
           reconsider y1=y as Element of Q;
           reconsider z=x1 \ y1 as Element of Q1;
           take z;
           thus x*z = x1 * (x1 \ y1)
           .= y;
         end;
         hereby let x,y be Element of Q1;
           reconsider x1=x as Element of Q;
           reconsider y1=y as Element of Q;
           reconsider z=y1 / x1 as Element of Q1;
           take z;
           thus z*x = (y1 / x1) * x1
           .= y;
         end;
      end;
    thus Q1 is cancelable
      proof
       thus Q1 is left_mult-cancelable
         proof
           let x be Element of Q1;
           let y,z be Element of Q1;
           reconsider x1=x,y1=y,z1=z as Element of Q;
           assume A: x*y=x*z;
           then x1*y1 = x1*z1;             
           hence y=z by ALGSTR_0:def 20;
         end;
       thus Q1 is right_mult-cancelable
        proof
           let x be Element of Q1;
           let y,z be Element of Q1;
           reconsider x1=x,y1=y,z1=z as Element of Q;
           assume A: y*x=z*x;
           then y1*x1 = z1*x1;             
           hence y=z by ALGSTR_0:def 21;
         end;
     end;
    hence thesis;
  end;
end;

definition
  let Q be multLoop;
  mode SubLoop of Q is well-unital invertible cancelable
  SubLoopStr of Q;
end;

registration
  let Q be multLoop;
  cluster -> well-unital invertible cancelable for SubLoop of Q;
  coherence
  proof
    let H be SubLoop of Q;
    H is multLoop;
    hence thesis;
  end;
end;

definition
  let Q be non empty multLoopStr;
  let H be SubLoopStr of Q;
  let A be Subset of H;
  func @ A -> Subset of Q equals A;
  coherence
  proof
    the carrier of H c= the carrier of Q by SubL;
    hence thesis by XBOOLE_1:1;
  end;
end;

definition
  let Q;
  let H1,H2 be Subset of Q;
  func loopclose1(H1,H2) -> Subset of Q means
  :Defloopclose1:
  x in it iff
  x in H1 or x = 1.Q or
  ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z);
  existence
  proof
    set H3 = {x : x in H1 or x = 1.Q or
    ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z)};
    H3 c= the carrier of Q
    proof
      let x be object;
      assume x in H3;
      then ex x1 be Element of Q st x = x1 & (x1 in H1 or x1 = 1.Q or
      ex y,z st y in H2 & z in H2 & (x1 = y * z or x1 = y \ z or x1 = y / z));
      then consider x1 being Element of Q such that
      H4: x = x1 & (x1 in H1 or x1 = 1.Q or
      ex y,z st y in H2 & z in H2 & (x1 = y * z or x1 = y \ z or x1 = y / z));
      H5: x in H1 or x = 1.Q or
      ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z) by H4;
      per cases by H5;
      suppose x in H1;
        hence thesis;
      end;
      suppose x = 1.Q;
        hence thesis;
      end;
      suppose ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z);
        hence thesis;
      end;
    end;
    then reconsider H3 as Subset of Q;
    take H3;
    let x be Element of Q;
    x in H3 implies
    x in H1 or x = 1.Q or
    ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z)
    proof
      assume x in H3;
      then consider x1 being Element of Q such that
      H4: x = x1 & (x1 in H1 or x1 = 1.Q or
      ex y,z st y in H2 & z in H2 & (x1 = y * z or x1 = y \ z or x1 = y / z));
      thus thesis by H4;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let H3,H4 be Subset of Q;
    assume that
    H3: x in H3 iff
    x in H1 or x = 1.Q or
    ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z)
    and
    H4: x in H4 iff
    x in H1 or x = 1.Q or
    ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z);
    now
      let x be Element of Q;
      x in H3 iff x in H1 or x = 1.Q or
      ex y,z st y in H2 & z in H2 & (x = y * z or x = y \ z or x = y / z) by H3;
      hence x in H3 iff x in H4 by H4;
    end;
    hence thesis by SUBSET_1:3;
  end;
end;

definition
  let Q;
  let H be Subset of Q;
  func lp H -> strict SubLoop of Q means
  :Deflp:
  H c= [#]it &
  for H2 be SubLoop of Q st H c= [#]H2 holds [#]it c= [#]H2;
  existence
  proof
    deffunc F(Subset of Q) = loopclose1(H,$1);
    consider f be Function of bool the carrier of Q,bool the carrier of Q
    such that
    H1: for X being Subset of Q holds f.X = F(X)
    from FUNCT_2:sch 4;
    f is c=-monotone
    proof
      let a1, b1 be set such that
      A1: a1 in dom f & b1 in dom f & a1 c= b1;
      A2: dom f = bool the carrier of Q by FUNCT_2:def 1;
      thus f.a1 c= f.b1
      proof
        reconsider a2 = a1 as Subset of Q by A1,A2;
        reconsider b2 = b1 as Subset of Q by A1,A2;
        let x be object;
        assume x in f.a1;
        then x in F(a2) by H1;
        then x in H or x = 1.Q or
        ex y,z st y in a2 & z in a2 & (x = y * z or x = y \ z or x = y / z)
        by Defloopclose1;
        then x in H or x = 1.Q or
        ex y,z st y in b2 & z in b2 & (x = y * z or x = y \ z or x = y / z)
        by A1;
        then x in F(b2) by Defloopclose1;
        hence x in f.b1 by H1;
      end;
    end;
    then reconsider f as
    c=-monotone Function of bool the carrier of Q,bool the carrier of Q; 
    set LFP= lfp(the carrier of Q,f);
    K1: LFP is_a_fixpoint_of f by KNASTER:4;
    then K1b: LFP in dom f & LFP = f.(LFP) & f.(LFP) = F(LFP) by ABIAN:def 3,H1;
    K2: for S be Subset of Q st f.S c= S holds LFP c= S by KNASTER:6;
    1.Q in F(LFP) by Defloopclose1;
    then A2: 1.Q in LFP by K1b;
    then reconsider ONE=1.Q as Element of LFP;
    set mm = (the multF of Q)||LFP;
    now let x be set such that N: x in [: LFP,LFP:];
      consider x1,x2 be object such that
      N1:x1 in LFP & x2 in LFP & x=[x1,x2] by N,ZFMISC_1:def 2;
      reconsider x1,x2 as Element of Q by N1;
      x1*x2 in F(LFP) by N1,Defloopclose1;
      hence (the multF of Q).x in LFP by N1,K1b;
    end;
    then
    LFP is Preserv of the multF of Q by REALSET1:def 1;
    then reconsider mm as BinOp of LFP by REALSET1:2;
    set LP =  multLoopStr(#LFP,mm,ONE#);
    T1: LP is non empty by A2;
    the multF of LP = (the multF of Q)||the carrier of LP;
    then 
    reconsider LP as non empty SubLoopStr of Q by T1,SubL;
    QQ: the carrier of LP is Subset of Q;
    LP is SubLoop of Q
    proof 
      now
        let x be Element of LP;
        x in the carrier of LP;
        then reconsider x1=x as Element of Q;
        x*1.LP = x1*1.Q & 1.LP*x = 1.Q*x1 by RING_3:1;
        hence x * 1. LP = x & 1.LP * x = x by VECTSP_1:def 6;
      end;
      then H1: LP is well-unital by VECTSP_1:def 6;
      H2: LP is invertible
      proof
        hereby let x,y be Element of LP;
          x in the carrier of LP &   y in the carrier of LP;
          then reconsider x1=x,y1=y as Element of Q;
          x1 in LFP & y1 in LFP;
          then x1\y1 in F(LFP) by Defloopclose1;
          then reconsider z=x1 \ y1 as Element of LP by K1b;
          take z;
          thus x*z = x1 * (x1 \ y1) by RING_3:1
          .= y;
        end;
        hereby let x,y be Element of LP;
          x in the carrier of LP &   y in the carrier of LP;
          then reconsider x1=x,y1=y as Element of Q;
          x1 in LFP & y1 in LFP;
          then y1/x1 in F(LFP) by Defloopclose1;
          then reconsider z=y1 / x1 as Element of LP by K1b;
          take z;
          thus z*x = (y1 / x1) * x1 by RING_3:1
          .= y;
        end;
      end;
      LP is  cancelable
      proof
        thus LP is left_mult-cancelable
        proof
          let x be Element of LP;
          let y,z be Element of LP;
          x in the carrier of LP
          & y in the carrier of LP
          & z in the carrier of LP;
          then reconsider x1=x,y1=y,z1=z as Element of Q;
          G: x1*y1 = x*y & x1*z1 = x*z by RING_3:1;
          hence thesis by ALGSTR_0:def 20;
        end;
        thus LP is right_mult-cancelable
        proof
          let x be Element of LP;
          let y,z be Element of LP;
          x in the carrier of LP
          & y in the carrier of LP
          & z in the carrier of LP;
          then reconsider x1=x,y1=y,z1=z as Element of Q;
          G: y1*x1 = y*x & z1*x1 = z*x by RING_3:1;
          hence thesis by ALGSTR_0:def 21;
        end;
        hence thesis by H1,H2;
      end;
      hence thesis by H1,H2;
    end;
    then 
    reconsider LP as strict SubLoop of Q;
    take LP;
    thus H c= [#]LP
    proof
      let x be object;
      assume x in H;
      then x in F(LFP) by Defloopclose1;
      then x in LFP by K1b;
      hence thesis;
    end;
    let H2 be SubLoop of Q such that
    A1: H c= [#]H2;
    reconsider H2c = [#]H2 as Subset of Q by SubL;
    f.([#]H2) c= [#]H2
    proof
      let x be object;
      assume x in f.([#]H2);
      then X:x in F(H2c) by H1;
      then reconsider xx=x as Element of Q;
      per cases by X,Defloopclose1;
      suppose x in H;
        hence thesis by A1;
      end;
      suppose x = 1.Q;
        then x = 1.H2 by SubL;
        hence thesis;
      end;
      suppose ex y,z st y in H2c & z in H2c &
        (x = y * z or x = y \ z or x = y / z);
        then consider y,z such that
        A4: y in H2c & z in H2c &
        (x = y * z or x = y \ z or x = y / z);
        reconsider y1=y,z1=z as Element of H2 by A4;
        y1\z1 in H2c;
        then reconsider yz =y1\z1 as Element of Q;
        y1/z1 in H2c;
        then reconsider YZ =y1/z1 as Element of Q;
        MM: the multF of H2 = (the multF of Q)||H2c by SubL;
        per cases by A4;
        suppose S:x = y * z;
          y*z = y1*z1 by A4,RING_3:1,MM;
          hence thesis by S;         
        end;
        suppose X: x = y \ z;
          y *yz = y1 * (y1\z1)= z
          by RING_3:1,MM;
          then yz = xx by X;
          hence thesis;   
        end;
        suppose X:x = y / z;
          YZ * z=  (y1/z1)* z1= y
          by RING_3:1,MM;
          then YZ = xx by X;
          hence thesis;  
        end;
      end; 
    end;
    then f.(H2c) c= H2c;
    hence [#]LP c= [#]H2 by K2;
  end;
  uniqueness
  proof
    let IT1,IT2 be strict SubLoop of Q such that
    A1: H c= [#]IT1 &
    for H2 be SubLoop of Q st H c= [#]H2 holds [#]IT1 c= [#]H2
    and A2: H c= [#]IT2 &
    for H2 be SubLoop of Q st H c= [#]H2 holds [#]IT2 c= [#]H2;
    [#]IT1 c= [#]IT2 & [#]IT2 c= [#]IT1 by A1,A2;
    then A3: [#]IT1 = [#]IT2 by XBOOLE_0:def 10;
    A4: the OneF of IT1 = 1.Q by SubL
    .= the OneF of IT2 by SubL;
    the multF of IT1 = (the multF of Q)||(the carrier of IT1) by SubL
    .= the multF of IT2 by SubL,A3;
    hence thesis by A3,A4;
  end;
end;

theorem subloopprop:
  for H be Subset of Q st
  1.Q in H & (for x,y st x in H & y in H holds x * y in H)
  & (for x,y st x in H & y in H holds x \ y in H)
  & (for x,y st x in H & y in H holds x / y in H)
  holds
  [#]lp H = H
proof
  let H be Subset of Q;
  assume that
  A1: 1.Q in H
  and
  A2: for x,y st x in H & y in H holds x * y in H
  and
  A3: for x,y st x in H & y in H holds x \ y in H
  and
  A4: for x,y st x in H & y in H holds x / y in H;
  HHJ: H c= [#]lp H by Deflp;
  reconsider ONE=1.Q as Element of H by A1;
  set mm = (the multF of Q)||H;
  now let x be set such that N: x in [: H,H:];
    consider x1,x2 be object such that
    N1:x1 in H & x2 in H & x=[x1,x2] by N,ZFMISC_1:def 2;
    reconsider x1,x2 as Element of Q by N1;
    x1*x2 in H by N1,A2;
    hence (the multF of Q).x in H by N1;
  end;
  then
  H is Preserv of the multF of Q by REALSET1:def 1;
  then reconsider mm as BinOp of H by REALSET1:2;
  set LP =  multLoopStr(#H,mm,ONE#);
  T1: LP is non empty by A1;
  the multF of LP = (the multF of Q)||the carrier of LP;
  then 
  reconsider LP as non empty SubLoopStr of Q by T1,SubL;
  QQ: the carrier of LP is Subset of Q;
  LP is SubLoop of Q
  proof 
    now
      let x be Element of LP;
      x in the carrier of LP;
      then reconsider x1=x as Element of Q;
      x*1.LP = x1*1.Q & 1.LP*x = 1.Q*x1 by RING_3:1;
      hence x * 1. LP = x & 1.LP * x = x by VECTSP_1:def 6;
    end;
    then  H1: LP is well-unital by VECTSP_1:def 6;
    H2: LP is invertible
    proof
      hereby let x,y be Element of LP;
        x in the carrier of LP &   y in the carrier of LP;
        then reconsider x1=x,y1=y as Element of Q;
        x1 in H & y1 in H;
        then x1\y1 in H by A2,A3,Defloopclose1;
        then reconsider z=x1 \ y1 as Element of LP;
        take z;
        thus x*z = x1 * (x1 \ y1) by RING_3:1
        .= y;
      end;
      hereby let x,y be Element of LP;
        x in the carrier of LP &   y in the carrier of LP;
        then reconsider x1=x,y1=y as Element of Q;
        x1 in H & y1 in H;
        then y1/x1 in H by A2,A3,A4,Defloopclose1;
        then reconsider z=y1 / x1 as Element of LP;
        take z;
        thus z*x = (y1 / x1) * x1 by RING_3:1
        .= y;
      end;
    end;
    LP is  cancelable
    proof
      thus LP is left_mult-cancelable
      proof
        let x be Element of LP;
        let y,z be Element of LP;
        x in the carrier of LP
        & y in the carrier of LP
        & z in the carrier of LP;
        then reconsider x1=x,y1=y,z1=z as Element of Q;
        G: x1*y1 = x*y & x1*z1 = x*z by RING_3:1;
        hence thesis by ALGSTR_0:def 20;
      end;
      thus LP is right_mult-cancelable
      proof
        let x be Element of LP;
        let y,z be Element of LP;
        x in the carrier of LP
        & y in the carrier of LP
        & z in the carrier of LP;
        then reconsider x1=x,y1=y,z1=z as Element of Q;
        G: y1*x1 = y*x & z1*x1 = z*x by RING_3:1;
        hence thesis by ALGSTR_0:def 21;
      end;
      hence thesis by H1,H2;
    end;
    hence thesis by H1,H2;
  end;
  then 
  reconsider LP as strict SubLoop of Q;
  [#](lp H) c= [#]LP = H by Deflp;
  then [#](lp H) = H by HHJ,XBOOLE_0:def 10;
  hence thesis;
end;

theorem KerSubLoop:
  for Q,Q2 holds for f being homomorphic Function of Q,Q2 holds
  [#]lp (Ker f) = Ker f
  proof
    let Q,Q2;
    let f be homomorphic Function of Q,Q2;
    f.(1.Q) = 1.Q2 by Defhom;
    then A1: 1.Q in Ker f by DefKer;
    A2: for x,y st x in Ker f & y in Ker f holds x * y in Ker f
    proof
      let x,y be Element of Q;
      assume that
      B1: x in Ker f
      and
      B2: y in Ker f;
      f.(x * y) = f.x * f.y by Defhom
      .= 1.Q2 * f.y by DefKer,B1
      .= f.y
      .= 1.Q2 by DefKer,B2;
      hence x*y in Ker f by DefKer;
    end;
    A3: for x,y st x in Ker f & y in Ker f holds x \ y in Ker f
    proof
      let x,y be Element of Q;
      assume that
      B1: x in Ker f
      and
      B2: y in Ker f;
      f.(x \ y) = f.x \ f.y by loopHomBackslash
      .= 1.Q2 \ f.y by DefKer,B1
      .= f.y
      .= 1.Q2 by DefKer,B2;
      hence x\y in Ker f by DefKer;
    end;
    for x,y st x in Ker f & y in Ker f holds x / y in Ker f
    proof
      let x,y be Element of Q;
      assume that
      B1: x in Ker f
      and
      B2: y in Ker f;
      f.(x / y) = f.x / f.y by loopHomSlash
      .= f.x / 1.Q2 by DefKer,B2
      .= f.x
      .= 1.Q2 by DefKer,B1;
      hence x/y in Ker f by DefKer;
    end;
    hence thesis by subloopprop,A1,A2,A3;
  end;
  
theorem NuclE:
  x in Nucl Q implies x in Nucl_l Q & x in Nucl_m Q & x in Nucl_r Q
proof
  assume x in Nucl Q;
  then Hx2: x in Nucl_l Q /\ Nucl_m Q /\ Nucl_r Q by DefNucl;
  then Hx3: x in Nucl_l Q /\ Nucl_m Q by XBOOLE_0:def 4;
  hence x in Nucl_l Q by XBOOLE_0:def 4;
  thus x in Nucl_m Q by XBOOLE_0:def 4, Hx3;
  thus x in Nucl_r Q by XBOOLE_0:def 4, Hx2;
end;

theorem NuclI:
  x in Nucl_l Q & x in Nucl_m Q & x in Nucl_r Q implies x in Nucl Q
proof
  assume that
  Hxl: x in Nucl_l Q
  and
  Hxm: x in Nucl_m Q
  and
  Hxr: x in Nucl_r Q;
  x in Nucl_l Q /\ Nucl_m Q by XBOOLE_0:def 4, Hxl, Hxm;
  then x in Nucl_l Q /\ Nucl_m Q /\ Nucl_r Q by XBOOLE_0:def 4, Hxr;
  hence x in Nucl Q by DefNucl;
end;

theorem Nucl1:
  1.Q in Nucl Q
proof
  for y,z holds (1.Q * y) * z = 1.Q * (y * z);
  then A1a: 1.Q in Nucl_l Q by DefNucll;
  for x,z holds (x * 1.Q) * z = x * (1.Q * z);
  then 1.Q in Nucl_m Q by DefNuclm;
  then A1b: 1.Q in Nucl_l Q /\ Nucl_m Q by XBOOLE_0:def 4, A1a;
  for x,y holds (x * y) * 1.Q = x * (y * 1.Q);
  then 1.Q in Nucl_r Q by DefNuclr;
  hence thesis by XBOOLE_0:def 4, DefNucl, A1b;
end;

theorem NuclClosStar:
  x in Nucl Q & y in Nucl Q implies x * y in Nucl Q
proof
  assume that
  Hx: x in Nucl Q
  and
  Hy: y in Nucl Q;
  Hxl: x in Nucl_l Q by NuclE,Hx;
  Hxm: x in Nucl_m Q by NuclE,Hx;
  Hxr: x in Nucl_r Q by NuclE,Hx;
  Hyl: y in Nucl_l Q by NuclE,Hy;
  Hym: y in Nucl_m Q by NuclE,Hy;
  Hyr: y in Nucl_r Q by NuclE,Hy;
  for z,w holds ((x * y) * z) * w = (x * y) * (z * w)
  proof
    let z,w;
    ((x * y) * z) * w = (x * (y * z)) * w by Hxl,DefNucll
    .= x * ((y * z) * w) by Hxl,DefNucll
    .= x * (y * (z * w)) by Hyl,DefNucll
    .= (x * y) * (z * w) by Hxl,DefNucll;
    hence thesis;
  end;
  then Hxyl: x * y in Nucl_l Q by DefNucll;
  for z,w holds (z * (x * y)) * w = z * ((x * y) * w)
  proof
    let z,w;
    (z * (x * y)) * w = ((z * x) * y) * w by Hxm,DefNuclm
    .= (z * x) * (y * w) by Hym,DefNuclm
    .= z * (x * (y * w)) by Hxm,DefNuclm
    .= z * ((x * y) * w) by Hym,DefNuclm;
    hence thesis;
  end;
  then Hxym: x * y in Nucl_m Q by DefNuclm;
  for z,w holds (z * w) * (x * y) = z * (w * (x * y))
  proof
    let z,w;
    (z * w) * (x * y) = ((z * w) * x) * y by Hyr,DefNuclr
    .= (z * (w * x)) * y by Hxr,DefNuclr
    .= z * ((w * x) * y) by Hyr,DefNuclr
    .= z * (w * (x * y)) by Hyr,DefNuclr;
    hence thesis;
  end;
  then x * y in Nucl_r Q by DefNuclr;
  hence thesis by NuclI,Hxyl,Hxym;
end;

theorem NuclClosBackslash:
  x in Nucl Q & y in Nucl Q implies x \ y in Nucl Q
proof
  assume that
  Hx: x in Nucl Q
  and
  Hy: y in Nucl Q;
  Hxl: x in Nucl_l Q by NuclE,Hx;
  Hxm: x in Nucl_m Q by NuclE,Hx;
  Hxr: x in Nucl_r Q by NuclE,Hx;
  Hyl: y in Nucl_l Q by NuclE,Hy;
  Hym: y in Nucl_m Q by NuclE,Hy;
  Hyr: y in Nucl_r Q by NuclE,Hy;
  for z,w holds ((x \ y) * z) * w = (x \ y) * (z * w)
  proof
    let z,w;
    x * (((x \ y) * z) * w) = (x * ((x \ y) * z)) * w by Hxl,DefNucll
    .= ((x * (x \ y)) * z) * w by Hxl,DefNucll
    .= (y * z) * w
    .= y * (z * w) by Hyl,DefNucll
    .= (x * (x \ y)) * (z * w)
    .= x * ((x \ y) * (z * w)) by Hxl,DefNucll;
    hence thesis by co3;
  end;
  then Hxyl: x \ y in Nucl_l Q by DefNucll;
  for z,w holds (z * (x \ y)) * w = z * ((x \ y) * w)
  proof
    let z,w;
    (z * (x \ y)) * w = (((z / x) * x) * (x \ y)) * w
    .= ((z / x) * (x * (x \ y))) * w by Hxm,DefNuclm
    .= ((z / x) * y) * w
    .= (z / x) * (y * w) by Hym,DefNuclm
    .= (z / x) * ((x * (x \ y)) * w)
    .= (z / x) * (x * ((x \ y) * w)) by Hxl,DefNucll
    .= ((z / x) * x) * ((x \ y) * w) by Hxm,DefNuclm
    .= z * ((x \ y) * w);
    hence thesis;
  end;
  then Hxym: x \ y in Nucl_m Q by DefNuclm;
  for z,w holds (z * w) * (x \ y) = z * (w * (x \ y))
  proof
    let z,w;
    (z * w) * (x \ y) = (z * ((w / x) * x)) * (x \ y)
    .= ((z * (w / x)) * x) * (x \ y) by Hxr,DefNuclr
    .= (z * (w / x)) * (x * (x \ y)) by Hxm,DefNuclm
    .= (z * (w / x)) * y
    .= z * ((w / x) * y) by Hyr,DefNuclr
    .= z * ((w / x) * (x * (x \ y)))
    .= z * (((w / x) * x) * (x \ y)) by Hxm,DefNuclm
    .= z * (w * (x \ y));
    hence thesis;
  end;
  then x \ y in Nucl_r Q by DefNuclr;
  hence thesis by NuclI,Hxyl,Hxym;
end;
  
theorem NuclClosSlash:
  x in Nucl Q & y in Nucl Q implies x / y in Nucl Q
proof
  assume that
  Hx: x in Nucl Q
  and
  Hy: y in Nucl Q;
  Hxl: x in Nucl_l Q by NuclE,Hx;
  Hxm: x in Nucl_m Q by NuclE,Hx;
  Hxr: x in Nucl_r Q by NuclE,Hx;
  Hyl: y in Nucl_l Q by NuclE,Hy;
  Hym: y in Nucl_m Q by NuclE,Hy;
  Hyr: y in Nucl_r Q by NuclE,Hy;
  for z,w holds ((x / y) * z) * w = (x / y) * (z * w)
  proof
    let z,w;
    ((x / y) * z) * w = ((x / y) * (y * (y \ z))) * w
    .= (((x / y) * y) * (y \ z)) * w by Hym,DefNuclm
    .= (x * (y \ z)) * w
    .= x * ((y \ z) * w) by Hxl,DefNucll
    .= ((x / y) * y) * ((y \ z) * w)
    .= (x / y) * (y * ((y \ z) * w)) by Hym,DefNuclm
    .= (x / y) * ((y * (y \ z)) * w) by Hyl,DefNucll
    .= (x / y) * (z * w);
    hence thesis;
  end;
  then Hxyl: x / y in Nucl_l Q by DefNucll;
  for z,w holds (z * (x / y)) * w = z * ((x / y) * w)
  proof
    let z,w;
    (z * (x / y)) * w = (z * (x / y)) * (y * (y \ w))
    .= ((z * (x / y)) * y) * (y \ w) by Hym,DefNuclm
    .= (z * ((x / y) * y)) * (y \ w) by Hyr,DefNuclr
    .= (z * x) * (y \ w)
    .= z * (x * (y \ w)) by Hxm, DefNuclm
    .= z * (((x / y) * y) * (y \ w))
    .= z * ((x / y) * (y * (y \ w))) by Hym,DefNuclm
    .= z * ((x / y) * w);
    hence thesis;
  end;
  then Hxym: x / y in Nucl_m Q by DefNuclm;
  for z,w holds (z * w) * (x / y) = z * (w * (x / y))
  proof
    let z,w;
    ((z * w) * (x / y)) * y = (z * w) * ((x / y) * y) by Hyr,DefNuclr
    .= (z * w) * x
    .= z * (w * x) by Hxr,DefNuclr
    .= z * (w * ((x / y) * y))
    .= z * ((w * (x / y)) * y) by Hyr,DefNuclr
    .= (z * (w * (x / y))) * y by Hyr,DefNuclr;
    hence thesis by co4;
  end;
  then x / y in Nucl_r Q by DefNuclr;
  hence thesis by NuclI,Hxyl,Hxym;
end;

theorem NuclSubLoop:
  [#]lp (Nucl Q) = Nucl Q
proof
  A1: 1.Q in Nucl Q by Nucl1;
  A2: for x,y st x in Nucl Q & y in Nucl Q holds x * y in Nucl Q by NuclClosStar;
  A3: for x,y st x in Nucl Q & y in Nucl Q holds x \ y in Nucl Q by NuclClosBackslash;
  A4: for x,y st x in Nucl Q & y in Nucl Q holds x / y in Nucl Q by NuclClosSlash;
  thus thesis by subloopprop,A1,A2,A3,A4;
end;

theorem CentSubLoop:
  [#]lp (Cent Q) = Cent Q
proof
  A1: 1.Q in Cent Q 
  proof
    AN1: 1.Q in Nucl Q by Nucl1;
    for y holds 1.Q * y = y * 1.Q;
    then 1.Q in Comm Q by DefComm;
    hence thesis by XBOOLE_0:def 4, DefCent, AN1;
  end;
  A2: for x,y st x in Cent Q & y in Cent Q holds x * y in Cent Q
  proof
    let x,y;
    assume that
    Hx: x in Cent Q
    and
    Hy: y in Cent Q;
    Hx2: x in Comm Q & x in Nucl Q by XBOOLE_0:def 4, DefCent, Hx;
    Hy2: y in Comm Q & y in Nucl Q by XBOOLE_0:def 4, DefCent, Hy;
    Hxl: x in Nucl_l Q by NuclE,Hx2;
    Hxm: x in Nucl_m Q by NuclE,Hx2;
    Hxr: x in Nucl_r Q by NuclE,Hx2;
    Hyl: y in Nucl_l Q by NuclE,Hy2;
    Hym: y in Nucl_m Q by NuclE,Hy2;
    Hyr: y in Nucl_r Q by NuclE,Hy2;
    for z holds (x * y) * z = z * (x * y)
    proof
      let z;
      (x * y) * z = x * (y * z) by Hym,DefNuclm
      .= x * (z * y) by Hy2,DefComm
      .= (x * z) * y by Hxl,DefNucll
      .= (z * x) * y by Hx2,DefComm
      .= z * (x * y) by Hyr,DefNuclr;
      hence thesis;
    end;
    then Hxyc: x * y in Comm Q by DefComm;
    x * y in Nucl Q by NuclClosStar,Hx2,Hy2;
    hence x * y in Cent Q by XBOOLE_0:def 4,DefCent,Hxyc;
  end;
  A3: for x,y st x in Cent Q & y in Cent Q holds x \ y in Cent Q
  proof
    let x,y;
    assume that
    Hx: x in Cent Q
    and
    Hy: y in Cent Q;
    Hx2: x in Comm Q & x in Nucl Q by XBOOLE_0:def 4, DefCent, Hx;
    Hy2: y in Comm Q & y in Nucl Q by XBOOLE_0:def 4, DefCent, Hy;
    Hxl: x in Nucl_l Q by NuclE,Hx2;
    Hxm: x in Nucl_m Q by NuclE,Hx2;
    Hxr: x in Nucl_r Q by NuclE,Hx2;
    Hyl: y in Nucl_l Q by NuclE,Hy2;
    Hym: y in Nucl_m Q by NuclE,Hy2;
    Hyr: y in Nucl_r Q by NuclE,Hy2;
    for z holds (x \ y) * z = z * (x \ y)
    proof
      let z;
      (x \ y) * z = (x \ y) * ((z / x) * x)
      .= (x \ y) * (x * (z / x)) by Hx2,DefComm
      .= ((x \ y) * x) * (z / x) by Hxm,DefNuclm
      .= (x * (x \ y)) * (z / x) by Hx2,DefComm
      .= y * (z / x)
      .= (z / x) * y by Hy2,DefComm
      .= (z / x) * (x * (x \ y))
      .= ((z / x) * x) * (x \ y) by Hxm,DefNuclm
      .= z * (x \ y);
      hence thesis;
    end;
    then Hxyc: x \ y in Comm Q by DefComm;
    x \ y in Nucl Q by NuclClosBackslash,Hx2,Hy2;
    hence x \ y in Cent Q by XBOOLE_0:def 4,DefCent,Hxyc;
  end;
  for x,y st x in Cent Q & y in Cent Q holds x / y in Cent Q
  proof
    let x,y;
    assume that
    Hx: x in Cent Q
    and
    Hy: y in Cent Q;
    Hx2: x in Comm Q & x in Nucl Q by XBOOLE_0:def 4, DefCent, Hx;
    Hy2: y in Comm Q & y in Nucl Q by XBOOLE_0:def 4, DefCent, Hy;
    Hxl: x in Nucl_l Q by NuclE,Hx2;
    Hxm: x in Nucl_m Q by NuclE,Hx2;
    Hxr: x in Nucl_r Q by NuclE,Hx2;
    Hyl: y in Nucl_l Q by NuclE,Hy2;
    Hym: y in Nucl_m Q by NuclE,Hy2;
    Hyr: y in Nucl_r Q by NuclE,Hy2;
    for z holds (x / y) * z = z * (x / y)
    proof
      let z;
      (x / y) * z = (x / y) * ((z / y) * y)
      .= (x / y) * (y * (z / y)) by Hy2,DefComm
      .= ((x / y) * y) * (z / y) by Hym,DefNuclm
      .= x * (z / y) by Hym,DefNuclm
      .= (z / y) * x by Hx2,DefComm
      .= (z / y) * ((x / y) * y)
      .= (z / y) * (y * (x / y)) by Hy2,DefComm
      .= ((z / y) * y) * (x / y) by Hym,DefNuclm
      .= z * (x / y) by Hyr,DefNuclr;
      hence thesis;
    end;
    then Hxyc: x / y in Comm Q by DefComm;
    x / y in Nucl Q by NuclClosSlash,Hx2,Hy2;
    hence x / y in Cent Q by XBOOLE_0:def 4,DefCent,Hxyc;
  end;
  hence thesis by subloopprop,A1,A2,A3;
end;

:: Mlt will now be defined and then used to define inner mappings and to define cosets (following Albert 1943 for cosets, roughly)

:: added the extra "in X" conditions so the case when X is empty works as expected
definition
  let X be functional set;
  attr X is composition-closed means
  :Defcompositionclosed:
  for f,g being Element of X st f in X & g in X holds f*g in X;
  attr X is invers-closed means
  :Definversclosed:
  for f being Element of X st f in X holds f" in X;
end;

registration
  let Q be non empty multLoopStr;
  cluster composition-closed invers-closed for
    Subset of Funcs(the carrier of Q,the carrier of Q);
  existence
  proof
    set X = {id (the carrier of Q)};
    id (the carrier of Q) in Funcs(the carrier of Q,the carrier of Q) by FUNCT_2:126;
    then reconsider X as Subset of Funcs(the carrier of Q,the carrier of Q) by SUBSET_1:33;
    take X;
    A1: X is composition-closed
    proof
      for f,g being Element of X holds f*g in X
      proof
        let f,g be Element of X;
        f in X & g in X;
        then f = id (the carrier of Q) & g = id (the carrier of Q) by TARSKI:def 1;
        then f*g = id (the carrier of Q) by SYSREL:12;
        hence f*g in X by TARSKI:def 1;
      end;
      hence thesis by Defcompositionclosed;
    end;
    X is invers-closed
    proof
      for f being Element of X holds f" in X
      proof
        let f be Element of X;
        f in X;
        then f = id (the carrier of Q) by TARSKI:def 1;
        then f is Permutation of (the carrier of Q) & id (the carrier of Q)*f = id(the carrier of Q) by SYSREL:12;
        then f" = id (the carrier of Q) by FUNCT_2:60;
        hence f" in X by TARSKI:def 1;
      end;
      hence thesis by Definversclosed;
    end;
    hence thesis by A1;
  end;
end;

definition
  let Q be non empty multLoopStr;
  let H be Subset of Q;
  let S be Subset of Funcs(the carrier of Q,the carrier of Q);
  pred H left-right-mult-closed S means
  :Defleftrightmultclosed:
  for u being Element of Q st u in H holds
  (curry (the multF of Q)).(u) in S
  &
  (curry' (the multF of Q)).(u) in S;
end;

definition
  let Q be non empty multLoopStr;
  let H be Subset of Q;
  let S be Subset of Funcs(the carrier of Q,the carrier of Q);
  func MltClos1(H,S) -> Subset of Funcs(the carrier of Q,the carrier of Q) means
  :DefMltClos1:
  for f being object holds
  f in it iff
  (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
  or
  (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
  or
  (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
  or
  (ex g be Permutation of the carrier of Q st g in S & f = g");
  existence
  proof
    set LH = {(curry' (the multF of Q)).(u) where u is Element of Q : u in H};
    set RH = {(curry (the multF of Q)).(u) where u is Element of Q : u in H};
    set SC = {g*h where g,h is Permutation of the carrier of Q : g in S & h in S};
    set SI = {g" where g is Permutation of the carrier of Q : g in S};
    set Y = LH \/ RH \/ SC \/ SI;
    T1: LH is Subset of Funcs(the carrier of Q,the carrier of Q)
    proof
      now
        let f be set;
        assume f in LH;
        then consider u being Element of Q such that
        H1: f = (curry' (the multF of Q)).(u) & u in H;
        thus f in Funcs(the carrier of Q,the carrier of Q) by H1;
      end;
      then LH c= Funcs(the carrier of Q,the carrier of Q);
      hence thesis by SUBSET:3;
    end;
    RH is Subset of Funcs(the carrier of Q,the carrier of Q)
    proof
      now
        let f be set;
        assume f in RH;
        then consider u being Element of Q such that
        H1: f = (curry (the multF of Q)).(u) & u in H;
        thus f in Funcs(the carrier of Q,the carrier of Q) by H1;
      end;
      then RH c= Funcs(the carrier of Q,the carrier of Q);
      hence thesis by SUBSET:3;
    end;
    then T2: LH \/ RH is Subset of Funcs(the carrier of Q,the carrier of Q) by T1, XBOOLE_1:8, SUBSET:3;
    SC is Subset of Funcs(the carrier of Q,the carrier of Q)
    proof
      now
        let f be set;
        assume f in SC;
        then consider g,h being Permutation of the carrier of Q such that
        H1: f = g*h & g in S & h in S;
        thus f in Funcs(the carrier of Q,the carrier of Q) by H1,FUNCT_2:9;
      end;
      then SC c= Funcs(the carrier of Q,the carrier of Q);
      hence thesis by SUBSET:3;
    end;
    then T3: LH \/ RH \/ SC is Subset of Funcs(the carrier of Q,the carrier of Q) by T2, XBOOLE_1:8, SUBSET:3;
    SI is Subset of Funcs(the carrier of Q,the carrier of Q)
    proof
      now
        let f be set;
        assume f in SI;
        then consider g being Permutation of the carrier of Q such that
        H1: f = g" & g in S;
        g" is Function of (the carrier of Q),(the carrier of Q) by H1,FUNCT_2:25;
        hence f in Funcs(the carrier of Q,the carrier of Q) by H1,FUNCT_2:9;
      end;
      then SI c= Funcs(the carrier of Q,the carrier of Q);
      hence thesis by SUBSET:3;
    end;
    then reconsider Y as Subset of Funcs(the carrier of Q,the carrier of Q) by T3, XBOOLE_1:8, SUBSET:3;
    take Y;
    thus for f being object holds
    f in Y iff
    (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in S & f = g")
    proof
      let f be object;
      thus f in Y implies
      (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
      or
      (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
      or
      (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
      or
      (ex g be Permutation of the carrier of Q st g in S & f = g")
      proof
        assume f in Y;
        then f in LH \/ RH \/ SC or f in SI by XBOOLE_0:def 3;
        then f in LH \/ RH or f in SC or f in SI by XBOOLE_0:def 3;
        then f in LH or f in RH or f in SC or f in SI by XBOOLE_0:def 3;
        then per cases;
        suppose f in LH;
          then consider u being Element of Q such that
          H1: f = (curry' (the multF of Q)).(u) & u in H;
          ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u) by H1;
          hence thesis;
        end;
        suppose f in RH;
          then consider u being Element of Q such that
          H1: f = (curry (the multF of Q)).(u) & u in H;
          ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u) by H1;
          hence thesis;
        end;
        suppose f in SC;
          then consider g,h being Permutation of the carrier of Q such that
          H1: f = g*h & g in S & h in S;
          ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h by H1;
          hence thesis;
        end;
        suppose f in SI;
          then consider g being Permutation of the carrier of Q such that
          H1: f = g" & g in S;
          ex g be Permutation of the carrier of Q st g in S & f = g" by H1;
          hence thesis;
        end;
      end;
      thus (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
      or
      (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
      or
      (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
      or
      (ex g be Permutation of the carrier of Q st g in S & f = g")
      implies f in Y
      proof
        assume (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u))
        or
        (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
        or
        (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
        or
        (ex g be Permutation of the carrier of Q st g in S & f = g");
        then per cases;
        suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
          then consider u being Element of Q such that
          H1: u in H & f = (curry' (the multF of Q)).(u);
          f in LH by H1;
          then f in LH \/ RH by XBOOLE_0:def 3;
          then f in LH \/ RH \/ SC by XBOOLE_0:def 3;
          hence f in Y by XBOOLE_0:def 3;
        end;
        suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
          then consider u being Element of Q such that
          H1: u in H & f = (curry (the multF of Q)).(u);
          f in RH by H1;
          then f in LH \/ RH by XBOOLE_0:def 3;
          then f in LH \/ RH \/ SC by XBOOLE_0:def 3;
          hence f in Y by XBOOLE_0:def 3;
        end;
        suppose ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h;
          then consider g,h being Permutation of the carrier of Q such that
          H1: g in S & h in S & f = g*h;
          f in SC by H1;
          then f in LH \/ RH \/ SC by XBOOLE_0:def 3;
          hence f in Y by XBOOLE_0:def 3;
        end;
        suppose ex g be Permutation of the carrier of Q st g in S & f = g";
          then consider g being Permutation of the carrier of Q such that
          H1: g in S & f = g";
          f in SI by H1;
          hence f in Y by XBOOLE_0:def 3;
        end;
      end;
    end;
  end;
  uniqueness
  proof
    let S1,S2 be Subset of Funcs(the carrier of Q,the carrier of Q);
    assume that
    HS1: for f being object holds
    f in S1 iff
    (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in S & f = g")
    and
    HS2: for f being object holds
    f in S2 iff
    (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in S & f = g");
    now
      let f be Element of Funcs(the carrier of Q,the carrier of Q);
      f in S1 iff (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
      or
      (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
      or
      (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
      or
      (ex g be Permutation of the carrier of Q st g in S & f = g") by HS1;
      hence f in S1 iff f in S2 by HS2;
    end;
    hence thesis by SUBSET_1:3;
  end;
end;

theorem MltClos1Monotone:
  for H being Subset of Q holds
  for phi being Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  st
  for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X)
  holds
  phi is c=-monotone  
proof
  let H be Subset of Q;
  let phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
  assume H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X);
  let a1, b1 be set such that
  A1: a1 in dom phi & b1 in dom phi & a1 c= b1;
  A2: dom phi = bool Funcs(the carrier of Q,the carrier of Q) by FUNCT_2:def 1;
  thus phi.a1 c= phi.b1
  proof
    reconsider a2 = a1 as Subset of Funcs(the carrier of Q,the carrier of Q) by A1,A2;
    reconsider b2 = b1 as Subset of Funcs(the carrier of Q,the carrier of Q) by A1,A2;
    let f be object;
    assume f in phi.a1;
    then f in MltClos1(H,a2) by H1;
    then (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in a2 & h in a2 & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in a2 & f = g") by DefMltClos1;
    then per cases;
    suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
      then f in MltClos1(H,b2) by DefMltClos1;
      hence f in phi.b1 by H1;
    end;
    suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
      then f in MltClos1(H,b2) by DefMltClos1;
      hence f in phi.b1 by H1;
    end;
    suppose ex g,h be Permutation of the carrier of Q st g in a2 & h in a2 & f = g*h;
      then ex g,h be Permutation of the carrier of Q st g in b2 & h in b2 & f = g*h by A1;
      then f in MltClos1(H,b2) by DefMltClos1;
      hence f in phi.b1 by H1;
    end;
    suppose ex g be Permutation of the carrier of Q st g in a2 & f = g";
      then ex g be Permutation of the carrier of Q st g in b2 & f = g" by A1;
      then f in MltClos1(H,b2) by DefMltClos1;
      hence f in phi.b1 by H1;
    end;
  end;
end;

theorem MltPFPProps:
  for H being Subset of Q holds
  for phi being Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  st
  for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X)
  holds
  for Y being Subset of Funcs(the carrier of Q,the carrier of Q)
  st
  phi.(Y) c= Y
  holds
  (for u being Element of Q st u in H holds (curry (the multF of Q)).(u) in Y)
  &
  (for u being Element of Q st u in H holds (curry' (the multF of Q)).(u) in Y)
proof
  let H be Subset of Q;
  let phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
  assume H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X);
  let Y be Subset of Funcs(the carrier of Q,the carrier of Q);
  assume K1: phi.(Y) c= Y;
  then K1b: MltClos1(H,Y) c= Y by H1;
  thus for u being Element of Q st u in H holds (curry (the multF of Q)).(u) in Y
  proof
    let u be Element of Q;
    assume u in H;
    then (curry (the multF of Q)).(u) in MltClos1(H,Y) by DefMltClos1;
    then (curry (the multF of Q)).(u) in Y by K1b;
    hence thesis;
  end;
  thus for u being Element of Q st u in H holds (curry' (the multF of Q)).(u) in Y
  proof
    let u be Element of Q;
    assume u in H;
    then (curry' (the multF of Q)).(u) in MltClos1(H,Y) by DefMltClos1;
    then (curry' (the multF of Q)).(u) in Y by K1b;
    hence thesis;
  end;
end;

theorem MltLPFPPerm:
  for H being Subset of Q holds
  for phi being Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  st
  for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X)
  holds
  for Y being Subset of Funcs(the carrier of Q,the carrier of Q)
  st
  for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Y c= S
  holds
  for f being Element of Funcs(the carrier of Q,the carrier of Q) st
  f in Y holds
  f is Permutation of the carrier of Q
proof
  let H be Subset of Q;
  let phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
  assume H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X);
  let Y be Subset of Funcs(the carrier of Q,the carrier of Q);
  assume K2: for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Y c= S;
  set SP = {f where f is Permutation of the carrier of Q : not contradiction };
  SP c= Funcs(the carrier of Q,the carrier of Q)
  proof
    let f be object;
    assume f in SP;
    then consider g being Permutation of the carrier of Q such that
    K3a: f = g & not contradiction;
    thus thesis by FUNCT_2:9,K3a;
  end;
  then reconsider SP as Subset of Funcs(the carrier of Q,the carrier of Q) by SUBSET:3;
  phi.(SP) c= SP
  proof
    let f be object;
    assume f in phi.(SP);
    then f in MltClos1(H,SP) by H1;
    then (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in SP & h in SP & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in SP & f = g") by DefMltClos1;
    then per cases;
    suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hf1: u in H & f = (curry' (the multF of Q)).(u);
      f in Funcs(the carrier of Q,the carrier of Q) by Hf1;
      then reconsider f as Function of Q,Q by FUNCT_2:66;
      deffunc G(Element of Q) = $1 / u;
      consider g be Function of Q,Q such that
      Hg: for x being Element of Q holds g.x = G(x) from FUNCT_2:sch 4;
      for x being Element of Q holds (g*f).(x) = (id (the carrier of Q)).(x)
      proof
        let x be Element of Q;
        (g * f).(x) = g.(f.(x)) by FUNCT_2:15
        .= g.(((curry' (the multF of Q)).(u)).(x)) by Hf1
        .= g.(x * u) by FUNCT_5:70
        .= G(x * u) by Hg
        .= (x * u) / u
        .= x
        .= (id (the carrier of Q)).(x) by FUNCT_1:18;
        hence thesis;
      end;
      then Hgf: g * f = id (the carrier of Q) by FUNCT_2:def 8;
      for x being Element of Q holds (f*g).(x) = (id (the carrier of Q)).(x)
      proof
        let x be Element of Q;
        (f * g).(x) = f.(g.(x)) by FUNCT_2:15
        .= ((curry' (the multF of Q)).(u)).(g.(x)) by Hf1
        .= g.(x) * u by FUNCT_5:70
        .= G(x) * u by Hg
        .= (x / u) * u
        .= x
        .= (id (the carrier of Q)).(x) by FUNCT_1:18;
        hence thesis;
      end;
      then Hfg: f * g = id (the carrier of Q) by FUNCT_2:def 8;
      Hf2: f is one-to-one by Hgf, FUNCT_2:31;
      Hf3: rng f = the carrier of Q by Hfg, FUNCT_2:18;
      f is Permutation of the carrier of Q by FUNCT_2:57,Hf2,Hf3;
      hence thesis;
    end;
    suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hf1: u in H & f = (curry (the multF of Q)).(u);
      f in Funcs(the carrier of Q,the carrier of Q) by Hf1;
      then reconsider f as Function of Q,Q by FUNCT_2:66;
      deffunc G(Element of Q) = u \ $1;
      consider g be Function of Q,Q such that
      Hg: for x being Element of Q holds g.x = G(x) from FUNCT_2:sch 4;
      for x being Element of Q holds (g*f).(x) = (id (the carrier of Q)).(x)
      proof
        let x be Element of Q;
        (g * f).(x) = g.(f.(x)) by FUNCT_2:15
        .= g.(((curry (the multF of Q)).(u)).(x)) by Hf1
        .= g.(u * x) by FUNCT_5:69
        .= G(u * x) by Hg
        .= u \ (u * x)
        .= x
        .= (id (the carrier of Q)).(x) by FUNCT_1:18;
        hence thesis;
      end;
      then Hgf: g * f = id (the carrier of Q) by FUNCT_2:def 8;
      for x being Element of Q holds (f*g).(x) = (id (the carrier of Q)).(x)
      proof
        let x be Element of Q;
        (f * g).(x) = f.(g.(x)) by FUNCT_2:15
        .= ((curry (the multF of Q)).(u)).(g.(x)) by Hf1
        .= u * g.(x) by FUNCT_5:69
        .= u * G(x) by Hg
        .= u * (u \ x)
        .= x
        .= (id (the carrier of Q)).(x) by FUNCT_1:18;
        hence thesis;
      end;
      then Hfg: f * g = id (the carrier of Q) by FUNCT_2:def 8;
      Hf2: f is one-to-one by Hgf, FUNCT_2:31;
      Hf3: rng f = the carrier of Q by Hfg, FUNCT_2:18;
      f is Permutation of the carrier of Q by FUNCT_2:57,Hf2,Hf3;
      hence thesis;
    end;
    suppose ex g,h be Permutation of the carrier of Q st g in SP & h in SP & f = g*h;
      then consider g,h being Permutation of the carrier of Q such that
      Hgh: g in SP & h in SP & f = g*h;
      f is Permutation of the carrier of Q by Hgh;
      hence thesis;
    end;
    suppose ex g be Permutation of the carrier of Q st g in SP & f = g";
      then consider g being Permutation of the carrier of Q such that
      Hg: g in SP & f = g";
      f is Permutation of the carrier of Q by Hg;
      hence thesis;
    end;
  end;
  then K3b: Y c= SP by K2;
  let f be Element of Funcs(the carrier of Q,the carrier of Q);
  assume f in Y;
  then f in SP by K3b;
  then consider g being Permutation of the carrier of Q such that
  K3c: f = g;
  thus thesis by K3c;
end;

theorem MltLFPProps:
  for H being Subset of Q holds
  for phi being Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  st
  for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X)
  holds
  for Y being Subset of Funcs(the carrier of Q,the carrier of Q)
  st
  Y is_a_fixpoint_of phi
  &
  for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Y c= S
  holds
  Y is composition-closed
  &
  Y is invers-closed
proof
  let H be Subset of Q;
  let phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
  assume H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X);
  let Y be Subset of Funcs(the carrier of Q,the carrier of Q);
  assume K1: Y is_a_fixpoint_of phi;
  then K1b: Y in dom phi & Y = phi.(Y) & phi.(Y) = MltClos1(H,Y) by ABIAN:def 3,H1;
  assume K2: for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Y c= S;
  K3: for f being Element of Funcs(the carrier of Q,the carrier of Q) st f in Y holds f is Permutation of the carrier of Q by MltLPFPPerm,H1,K2;
  for f,g being Element of Y st f in Y & g in Y holds f*g in Y
  proof
    let f,g be Element of Y;
    assume Hfg1: f in Y & g in Y;
    then f is Permutation of the carrier of Q & g is Permutation of the carrier of Q by K3;
    then f * g in MltClos1(H,Y) by DefMltClos1,Hfg1;
    then f * g in phi.(Y) by H1;
    hence f * g in Y by K1b;
  end;
  hence Y is composition-closed by Defcompositionclosed;
  for f being Element of Y st f in Y holds f" in Y
  proof
    let f be Element of Y;
    assume Hf1: f in Y;
    then f is Permutation of the carrier of Q by K3;
    then f" in MltClos1(H,Y) by DefMltClos1,Hf1;
    then f" in phi.(Y) by H1;
    hence f" in Y by K1b;
  end;
  hence Y is invers-closed;
end;

theorem MltLPerm:
  (curry (the multF of Q)).(u) is Permutation of the carrier of Q
proof
  set f = curry (the multF of Q).(u);
  deffunc G(Element of Q) = u \ $1;
  consider g be Function of Q,Q such that
  Hg: for x being Element of Q holds g.x = G(x) from FUNCT_2:sch 4;
  for x being Element of Q holds (g*f).(x) = (id (the carrier of Q)).(x)
  proof
    let x be Element of Q;
    (g * f).(x) = g.(f.(x)) by FUNCT_2:15
    .= g.(((curry (the multF of Q)).(u)).(x))
    .= g.(u * x) by FUNCT_5:69
    .= G(u * x) by Hg
    .= u \ (u * x)
    .= x
    .= (id (the carrier of Q)).(x) by FUNCT_1:18;
    hence thesis;
  end;
  then Hgf: g * f = id (the carrier of Q) by FUNCT_2:def 8;
  for x being Element of Q holds (f*g).(x) = (id (the carrier of Q)).(x)
  proof
    let x be Element of Q;
    (f * g).(x) = f.(g.(x)) by FUNCT_2:15
    .= ((curry (the multF of Q)).(u)).(g.(x))
    .= u * g.(x) by FUNCT_5:69
    .= u * G(x) by Hg
    .= u * (u \ x)
    .= x
    .= (id (the carrier of Q)).(x) by FUNCT_1:18;
    hence thesis;
  end;
  then Hfg: f * g = id (the carrier of Q) by FUNCT_2:def 8;
  L1: f is one-to-one by Hgf, FUNCT_2:31;
  rng f = the carrier of Q by Hfg,FUNCT_2:18;
  hence thesis by FUNCT_2:57,L1;
end;

theorem MltRPerm:
  (curry' (the multF of Q)).(u) is Permutation of the carrier of Q
proof
  set f = curry' (the multF of Q).(u);
  deffunc G(Element of Q) = $1 / u;
  consider g be Function of Q,Q such that
  Hg: for x being Element of Q holds g.x = G(x) from FUNCT_2:sch 4;
  for x being Element of Q holds (g*f).(x) = (id (the carrier of Q)).(x)
  proof
    let x be Element of Q;
    (g * f).(x) = g.(f.(x)) by FUNCT_2:15
    .= g.(((curry' (the multF of Q)).(u)).(x))
    .= g.(x * u) by FUNCT_5:70
    .= G(x * u) by Hg
    .= (x * u) / u
    .= x
    .= (id (the carrier of Q)).(x) by FUNCT_1:18;
    hence thesis;
  end;
  then Hgf: g * f = id (the carrier of Q) by FUNCT_2:def 8;
  for x being Element of Q holds (f*g).(x) = (id (the carrier of Q)).(x)
  proof
    let x be Element of Q;
    (f * g).(x) = f.(g.(x)) by FUNCT_2:15
    .= ((curry' (the multF of Q)).(u)).(g.(x))
    .= g.(x) * u by FUNCT_5:70
    .= G(x) * u by Hg
    .= (x / u) * u
    .= x
    .= (id (the carrier of Q)).(x) by FUNCT_1:18;
    hence thesis;
  end;
  then Hfg: f * g = id (the carrier of Q) by FUNCT_2:def 8;
  L1: f is one-to-one by Hgf, FUNCT_2:31;
  rng f = the carrier of Q by Hfg,FUNCT_2:18;
  hence thesis by FUNCT_2:57,L1;
end;

theorem compPerm:
  for X being set holds
  for f,g being Permutation of X holds
  f*g is Permutation of X
proof
  let X be set;
  let f,g be Permutation of X;
  f*(f") = id X & g*(g") = id X by FUNCT_2:61;
  then rng f = X & rng g = X by FUNCT_2:18;
  then rng (f*g) = X by FUNCT_2:53;
  hence thesis by FUNCT_2:57;
end;

definition
  let Q;
  let H be Subset of Q;
  func Mlt H -> composition-closed invers-closed
  Subset of Funcs(the carrier of Q,the carrier of Q) means
  :DefMlt:
  H left-right-mult-closed it
  &
  for X being composition-closed invers-closed
  Subset of Funcs(the carrier of Q,the carrier of Q)
  st H left-right-mult-closed X
  holds it c= X;
  existence
  proof
    deffunc Phi(Subset of Funcs(the carrier of Q,the carrier of Q)) = MltClos1(H,$1);
    consider phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
    such that
    H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = Phi(X)
    from FUNCT_2:sch 4;
    H1b: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X) by H1;
    then phi is c=-monotone by MltClos1Monotone;
    then reconsider phi as
    c=-monotone Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
    set Y = lfp(Funcs(the carrier of Q,the carrier of Q),phi);
    K1: Y is_a_fixpoint_of phi by KNASTER:4;
    then K1b: Y in dom phi & Y = phi.(Y) & phi.(Y) = Phi(Y) by ABIAN:def 3,H1;
    then K1c: phi.(Y) c= Y;
    K2: for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Y c= S by KNASTER:6;
    KL: for u being Element of Q st u in H holds (curry (the multF of Q)).(u) in Y by MltPFPProps,H1b,K1c;
    KR: for u being Element of Q st u in H holds (curry' (the multF of Q)).(u) in Y by MltPFPProps,H1b,K1c;
    reconsider Y as composition-closed invers-closed Subset of Funcs(the carrier of Q,the carrier of Q) by MltLFPProps,H1b,K1,K2;
    take Y;
    thus H left-right-mult-closed Y by KL,KR;
    let S be composition-closed invers-closed
    Subset of Funcs(the carrier of Q,the carrier of Q);
    assume HS: H left-right-mult-closed S;
    phi.S c= S
    proof
      let f be object;
      assume f in phi.S;
      then f in Phi(S) by H1;
      then
      (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
      or
      (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
      or
      (ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h)
      or
      (ex g be Permutation of the carrier of Q st g in S & f = g")
      by DefMltClos1;
      then per cases;
      suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
        then consider u being Element of Q such that
        Hu: u in H & f = (curry' (the multF of Q)).(u);
        thus thesis by Hu,HS;
      end;
      suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
        then consider u being Element of Q such that
        Hu: u in H & f = (curry (the multF of Q)).(u);
        thus thesis by Hu,HS;
      end;
      suppose ex g,h be Permutation of the carrier of Q st g in S & h in S & f = g*h;
        then consider g,h being Permutation of the carrier of Q such that
        Hgh: g in S & h in S & f = g*h;
        thus thesis by Hgh,Defcompositionclosed;
      end;
      suppose ex g be Permutation of the carrier of Q st g in S & f = g";
        then consider g being Permutation of the carrier of Q such that
        Hg: g in S & f = g";
        thus thesis by Hg,Definversclosed;
      end;
    end;
    hence Y c= S by K2;
  end;
  uniqueness;
end;

theorem MltL:
  for H being Subset of Q holds
  for u being Element of Q st u in H holds (curry (the multF of Q)).(u) in Mlt H
proof
  let H be Subset of Q;
  let u be Element of Q;
  assume Hu: u in H;
  H left-right-mult-closed (Mlt H) by DefMlt;
  hence thesis by Defleftrightmultclosed,Hu;
end;
  
theorem MltR:
  for H being Subset of Q holds
  for u being Element of Q st u in H holds (curry' (the multF of Q)).(u) in Mlt H
proof
  let H be Subset of Q;
  let u be Element of Q;
  assume Hu: u in H;
  H left-right-mult-closed (Mlt H) by DefMlt;
  hence thesis by Defleftrightmultclosed,Hu;
end;

theorem MltLFP:
  for H being Subset of Q holds
  for phi being Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  st
  for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X)
  holds
  Mlt H is_a_fixpoint_of phi
  &
  for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Mlt H c= S
proof
  let H be Subset of Q;
  let phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q);
  assume H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X);
  M1: Mlt H in dom phi
  proof
    Mlt H in bool Funcs(the carrier of Q,the carrier of Q)
    &
    phi is quasi_total;
    hence thesis by FUNCT_2:def 1;
  end;
  M2: H left-right-mult-closed Mlt H by DefMlt;
  M3: for X being composition-closed invers-closed
  Subset of Funcs(the carrier of Q,the carrier of Q)
  st H left-right-mult-closed X
  holds Mlt H c= X by DefMlt;
  M4: phi.(Mlt H) c= Mlt H
  proof
    let f be object;
    assume f in phi.(Mlt H);
    then f in MltClos1(H,Mlt H) by H1;
    then (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in Mlt H & h in Mlt H & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in Mlt H & f = g") by DefMltClos1;
    then per cases;
    suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hu: u in H & f = (curry' (the multF of Q)).(u);
      thus thesis by MltR,Hu;
    end;
    suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hu: u in H & f = (curry (the multF of Q)).(u);
      thus thesis by MltL,Hu;
    end;
    suppose ex g,h be Permutation of the carrier of Q st g in Mlt H & h in Mlt H & f = g*h;
      then consider g,h being Permutation of the carrier of Q
      such that
      Hgh: g in Mlt H & h in Mlt H & f = g*h;
      f in Mlt H by Hgh,Defcompositionclosed;
      hence thesis;
    end;
    suppose ex g be Permutation of the carrier of Q st g in Mlt H & f = g";
      then consider g being Permutation of the carrier of Q such that
      Hg: g in Mlt H & f = g";
      f in Mlt H by Hg,Definversclosed;
      hence thesis;
    end;
  end;
  M4L: for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Mlt H c= S
  proof
    let S be Subset of Funcs(the carrier of Q,the carrier of Q);
    assume HS: phi.S c= S;
    set SP = {f where f is Permutation of the carrier of Q : f in S};
    SPS: SP c= S
    proof
      let g be object;
      assume g in SP;
      then consider f being Permutation of the carrier of Q such that
      Hf: g = f & f in S;
      thus thesis by Hf;
    end;
    then S c= Funcs(the carrier of Q,the carrier of Q) by SUBSET:3;
    then SP c= Funcs(the carrier of Q,the carrier of Q) by XBOOLE_1:2,SPS;
    then reconsider SP as Subset of Funcs(the carrier of Q,the carrier of Q) by SUBSET:3;
    SPP: for f being Element of SP st f in SP holds f is Permutation of the carrier of Q
    proof
      let f be Element of SP;
      assume f in SP;
      then consider g being Permutation of the carrier of Q such that
      Hg: f = g & g in S;
      thus thesis by Hg;
    end;
    for f,g being Element of SP st f in SP & g in SP holds f*g in SP
    proof
      let f,g be Element of SP;
      assume Hfg: f in SP & g in SP;
      then Hfg2: f in S & g in S by SPS;
      reconsider f as Permutation of the carrier of Q by SPP,Hfg;
      reconsider g as Permutation of the carrier of Q by SPP,Hfg;
      f*g in MltClos1(H,S) by DefMltClos1,Hfg2;
      then f*g in phi.S by H1;
      then HfgS: f*g in S by HS;
      f*g is Permutation of the carrier of Q by compPerm;
      hence thesis by HfgS;
    end;
    then SPc: SP is composition-closed by Defcompositionclosed;
    for f being Element of SP st f in SP holds f" in SP
    proof
      let f be Element of SP;
      assume f in SP;
      then Hf: f in S & f is Permutation of the carrier of Q by SPS,SPP;
      then f" in MltClos1(H,S) by DefMltClos1,Hf;
      then f" in phi.S by H1;
      then HfS: f" in S by HS;
      reconsider f as Permutation of the carrier of Q by Hf;
      f" is Permutation of the carrier of Q;
      hence thesis by HfS;
    end;
    then SP is invers-closed by Definversclosed;
    then reconsider SP as composition-closed invers-closed Subset of Funcs(the carrier of Q,the carrier of Q) by SPc;
    for u being Element of Q st u in H holds
    (curry (the multF of Q)).(u) in SP
    &
    (curry' (the multF of Q)).(u) in SP
    proof
      let u be Element of Q;
      assume Hu: u in H;
      then (curry (the multF of Q)).(u) in MltClos1(H,S) by DefMltClos1;
      then (curry (the multF of Q)).(u) in phi.(S) by H1;
      then Hc1: (curry (the multF of Q)).(u) in S by HS;
      (curry (the multF of Q)).(u) is Permutation of the carrier of Q by MltLPerm;
      hence (curry (the multF of Q)).(u) in SP by Hc1;
      (curry' (the multF of Q)).(u) in MltClos1(H,S) by DefMltClos1,Hu;
      then (curry' (the multF of Q)).(u) in phi.(S) by H1;
      then Hc2: (curry' (the multF of Q)).(u) in S by HS;
      (curry' (the multF of Q)).(u) is Permutation of the carrier of Q by MltRPerm;
      hence (curry' (the multF of Q)).(u) in SP by Hc2;
    end;
    then H left-right-mult-closed SP by Defleftrightmultclosed;
    then Mlt H c= SP by M3;
    hence thesis by SPS;
  end;
  M5: Mlt H c= phi.(Mlt H)
  proof
    for f,g being Element of phi.(Mlt H) st f in phi.(Mlt H) & g in phi.(Mlt H) holds f*g in phi.(Mlt H)
    proof
      let f,g be Element of phi.(Mlt H);
      assume f in phi.(Mlt H) & g in phi.(Mlt H);
      then Hfg: f in Mlt H & g in Mlt H by M4;
      then
      f is Permutation of the carrier of Q
      &
      g is Permutation of the carrier of Q
      by MltLPFPPerm,H1,M4L;
      then f * g in MltClos1(H,Mlt H) by DefMltClos1,Hfg;
      hence thesis by H1;
    end;
    then M5c: phi.(Mlt H) is composition-closed by Defcompositionclosed;
    for f being Element of phi.(Mlt H) st f in phi.(Mlt H) holds f" in phi.(Mlt H)
    proof
      let f be Element of phi.(Mlt H);
      assume f in phi.(Mlt H);
      then Hf: f in Mlt H by M4;
      then f is Permutation of the carrier of Q by MltLPFPPerm,H1,M4L;
      then f" in MltClos1(H,Mlt H) by DefMltClos1,Hf;
      hence thesis by H1;
    end;
    then phi.(Mlt H) is invers-closed by Definversclosed;
    then reconsider S = phi.(Mlt H) as composition-closed invers-closed
    Subset of Funcs(the carrier of Q,the carrier of Q) by M5c;
    for u being Element of Q st u in H holds
    (curry (the multF of Q)).(u) in S
    &
    (curry' (the multF of Q)).(u) in S
    proof
      let u be Element of Q;
      assume u in H;
      then (curry (the multF of Q)).(u) in MltClos1(H,Mlt H)
      &
      (curry' (the multF of Q)).(u) in MltClos1(H,Mlt H)
      by DefMltClos1;
      hence thesis by H1;
    end;
    then H left-right-mult-closed S;
    hence thesis by M3;
  end;
  then Mlt H = phi.(Mlt H) by M4,M5;
  hence Mlt H is_a_fixpoint_of phi by ABIAN:def 3,M1;
  thus thesis by M4L;
end;

theorem MltPerm:
  for H being Subset of Q holds
  for f being Element of Funcs(the carrier of Q,the carrier of Q) st
  f in Mlt H holds
  f is Permutation of the carrier of Q
proof
  let H be Subset of Q;
  deffunc Phi(Subset of Funcs(the carrier of Q,the carrier of Q)) = MltClos1(H,$1);
  consider phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  such that
  H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = Phi(X)
  from FUNCT_2:sch 4;
  H1b: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X) by H1;
  for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Mlt H c= S
  by MltLFP,H1b;
  hence thesis by MltLPFPPerm,H1b;
end;

definition
  let Q;
  let H be Subset of Q;
  let x be Element of Q;
  func x * H -> Subset of Q means
  :DefSubsetCoset:
  y in it iff
  ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x);
  existence
  proof
    set xH = {h.(x) where h is Permutation of the carrier of Q : h in Mlt H};
    xH c= the carrier of Q
    proof
      let y be object;
      assume y in xH;
      then consider h being Permutation of the carrier of Q such that
      Hh: y = h.(x) & h in Mlt H;
      thus thesis by Hh;
    end;
    then reconsider xH as Subset of Q;
    take xH;
    let y;
    thus y in xH implies ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x)
    proof
      assume y in xH;
      then consider h being Permutation of the carrier of Q such that
      Hh: y = h.(x) & h in Mlt H;
      thus thesis by Hh;
    end;
    thus (ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x)) implies y in xH
    proof
      assume ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x);
      then consider h being Permutation of the carrier of Q such that
      Hh: h in Mlt H & y = h.(x);
      thus thesis by Hh;
    end;
  end;
  uniqueness
  proof
    let xH1,xH2 be Subset of Q;
    assume that
    HxH1: for y holds y in xH1 iff
    ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x)
    and
    HxH2: for y holds y in xH2 iff
    ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x);
    for y holds y in xH1 iff y in xH2
    proof
      let y;
      y in xH1 iff
      ex h be Permutation of the carrier of Q st h in Mlt H & y = h.(x) by HxH1;
      hence y in xH1 iff y in xH2 by HxH2;
    end;
    hence xH1 = xH2 by SUBSET_1:3;
  end;
end;

definition
  let Q;
  let H be SubLoop of Q;
  let x be Element of Q;
  func x * H -> Subset of Q equals
  :DefSubLoopCoset:
  x * (@ ([#] H));
  coherence;
end;

definition
  let Q;
  let N be SubLoop of Q;
  func Cosets N -> Subset-Family of Q means
  :DefCosets:
  for H be Subset of Q holds
  H in it iff ex x st H = x * N;
  existence
  proof
    set LCS = {x * N : not contradiction };
    LCS c= bool the carrier of Q
    proof
      let x be object;assume x in LCS;
      then ex y st
      x = y * N & not contradiction;
      hence thesis;
    end;
    then reconsider LCS as Subset-Family of Q;
    take LCS;
    let H be Subset of Q;
    H in LCS implies 
    ex x st H = x * N
    proof
      assume H in LCS;
      then ex x st
      H = x * N;
      hence thesis;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let C1,C2 be Subset-Family of Q;
    assume that
    A1: for H be Subset of Q holds H in C1 iff
    ex x st H = x * N and
    A2: for H be Subset of Q holds H in C2 iff
    ex x st H = x * N;
    thus C1 c= C2
    proof
      let H be object;
      reconsider H1=H as set by TARSKI:1;
      assume H in C1;
      then
      ex x st H = x * N by A1;
      hence H in C2 by A2;
    end;
    thus C2 c= C1
    proof
      let H be object;
      reconsider H1=H as set by TARSKI:1;
      assume H in C2;
      then ex x st
      H = x * N by A2;
      hence H in C1 by A1;
    end;
  end;
end;

registration
  let Q;
  let N be SubLoop of Q;
  cluster Cosets N -> non empty;
  coherence
  proof
    1.Q * N in Cosets N by DefCosets;
    hence thesis;
  end;
end;

definition
  let Q be multLoopStr;
  let H1,H2 be Subset of Q;
  func H1 * H2 -> Subset of Q means
  :DefHH:
  for x being Element of Q holds
  x in it iff
  ex y,z be Element of Q st y in H1 & z in H2 & x = y * z;
  existence
  proof
    set H3 = {x where x is Element of Q : ex y,z be Element of Q st y in H1 & z in H2 & x = y * z};
    H3 c= the carrier of Q
    proof
      let x be object;
      assume x in H3;
      then ex x1 be Element of Q st x = x1 & ex y,z be Element of Q st y in H1 & z in H2 & x1 = y * z;
      hence thesis;
    end;
    then reconsider H3 as Subset of Q;
    take H3;
    let x be Element of Q;
    x in H3 implies ex y,z be Element of Q st y in H1 & z in H2 & x = y * z
    proof
      assume x in H3;
      then consider x1 be Element of Q such that
      A1: x = x1 & ex y,z be Element of Q st y in H1 & z in H2 & x1 = y * z;
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let H31,H32 be Subset of Q;
    assume that
    H31: for x being Element of Q holds
    x in H31 iff
    ex y,z be Element of Q st y in H1 & z in H2 & x = y * z
    and
    H32: for x being Element of Q holds
    x in H32 iff
    ex y,z be Element of Q st y in H1 & z in H2 & x = y * z;
    now
      let x be Element of Q;
      x in H31 iff
      ex y,z be Element of Q st y in H1 & z in H2 & x = y * z by H31;
      hence x in H31 iff x in H32 by H32;
    end;
    hence thesis by SUBSET_1:3;
  end;
  func H1 \ H2 -> Subset of Q means
  :DefHbH:
  for x being Element of Q holds
  x in it iff
  ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z;
  existence
  proof
    set H3 = {x where x is Element of Q : ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z};
    H3 c= the carrier of Q
    proof
      let x be object;
      assume x in H3;
      then ex x1 be Element of Q st x = x1 & ex y,z be Element of Q st y in H1 & z in H2 & x1 = y \ z;
      hence thesis;
    end;
    then reconsider H3 as Subset of Q;
    take H3;
    let x be Element of Q;
    x in H3 implies ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z
    proof
      assume x in H3;
      then consider x1 be Element of Q such that
      A1: x = x1 & ex y,z be Element of Q st y in H1 & z in H2 & x1 = y \ z;
      thus thesis by A1;
    end;
    hence thesis;
  end;
  uniqueness
  proof
    let H31,H32 be Subset of Q;
    assume that
    H31: for x being Element of Q holds
    x in H31 iff
    ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z
    and
    H32: for x being Element of Q holds
    x in H32 iff
    ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z;
    now
      let x be Element of Q;
      x in H31 iff
      ex y,z be Element of Q st y in H1 & z in H2 & x = y \ z by H31;
      hence x in H31 iff x in H32 by H32;
    end;
    hence thesis by SUBSET_1:3;
  end;
end;

definition
  let Q be multLoop;
  let H be SubLoop of Q;
  attr H is normal means
  :Defnormal:
  for x,y being Element of Q holds
  (x * H) * (y * H) = (x * y) * H
  &
  for z being Element of Q holds
  ((x * H) * (y * H) = (x * H) * (z * H) implies (y * H) = (z * H))
  &
  ((y * H) * (x * H) = (z * H) * (x * H) implies (y * H) = (z * H));
end;

registration 
  let Q;
  cluster normal for SubLoop of Q;
  existence
  proof
    reconsider Q1=Q as non empty multLoopStr;
    R1: the multF of Q1 = (the multF of Q)||the carrier of Q1;
    R2: the OneF of Q1 = the OneF of Q;
    then reconsider Q1 as SubLoop of Q by R1,R2,SubL;
    take Q1;
    L1: for x,y being Element of Q holds y in x * Q1
    proof
      let x,y be Element of Q;
      (ex g being Permutation of the carrier of Q st g in Mlt (@ ([#] Q1)) & y = g.(x))
      proof
        set g = (curry (the multF of Q)).(y / x);
        (@ ([#] Q1)) left-right-mult-closed Mlt (@ ([#] Q1)) by DefMlt;
        then HgM: g in Mlt (@ ([#] Q1)) by Defleftrightmultclosed;
        g.(x) = ((curry (the multF of Q)).(y / x)).(x)
        .= (y / x) * x by FUNCT_5:69
        .= y;
        then Hgxy: y = g.(x);
        reconsider g as Permutation of the carrier of Q by MltLPerm;
        take g;
        thus thesis by Hgxy,HgM;
      end;
      then y in x * (@ ([#] Q1)) by DefSubsetCoset;
      hence y in x * Q1 by DefSubLoopCoset;
    end;
    L2: for x,y being Element of Q holds x * Q1 = y * Q1
    proof
      let x,y be Element of Q;
      for v being Element of Q holds v in x * Q1 iff v in y * Q1 by L1;
      hence thesis by SUBSET_1:3;
    end;
    now
      let x,y be Element of Q;
      for v being Element of Q holds v in (x*Q1)*(y*Q1) iff v in (x*y)*Q1
      proof
        let v be Element of Q;
        thus v in (x*Q1)*(y*Q1) implies v in (x*y)*Q1 by L1;
        assume v in (x*y)*Q1;
        ex u,w st u in x * Q1 & w in y * Q1 & v = u * w
        proof
          take v;
          take 1.Q;
          thus thesis by L1;
        end;
        hence v in (x*Q1)*(y*Q1) by DefHH;
      end;
      hence (x*Q1)*(y*Q1) = (x*y)*Q1 by SUBSET_1:3;
      let z;
      thus (x*Q1)*(z*Q1) = (y*Q1)*(z*Q1) implies (x*Q1) = (y*Q1) by L2;
      thus (z*Q1)*(x*Q1) = (z*Q1)*(y*Q1) implies (x*Q1) = (y*Q1) by L2;
    end;
    hence thesis by Defnormal;
  end;
end;

definition
  let Q;
  let N be normal SubLoop of Q;
  func SubLoop_As_Coset N -> Element of Cosets N equals
  :DefSubLoopAsCoset:
  1.Q * N;
  coherence by DefCosets;
end;

definition
  let Q;
  let N be normal SubLoop of Q;
  func Coset_Loop_Op N -> BinOp of Cosets N
  means
  :DefCosetLoopOp:
  for H1,H2 be Element of Cosets N holds
  it.(H1,H2) = H1 * H2;
  existence
  proof
    deffunc G(Element of Cosets N,Element of Cosets N) = $1 * $2;
    L1: for H1,H2 being Element of Cosets N holds G(H1,H2) in Cosets N
    proof
      let H1,H2 be Element of Cosets N;
      H1 in Cosets N;
      then consider x being Element of Q such that
      Hx: H1 = x * N
      by DefCosets;
      H2 in Cosets N;
      then consider y being Element of Q such that
      Hy: H2 = y * N
      by DefCosets;
      G(H1,H2) = (x * N) * (y * N) by Hx,Hy
      .= (x * y) * N by Defnormal;
      hence G(H1,H2) in Cosets N by DefCosets;
    end;
    consider g being Function of [: Cosets N,Cosets N :],Cosets N such that
    Hg: for H1,H2 being Element of Cosets N holds g.(H1,H2) = G(H1,H2)
    from FUNCT_7:sch 1(L1);
    take g;
    thus thesis by Hg;
  end;
  uniqueness
  proof
    let LCL1,LCL2 be BinOp of Cosets N such that
    A1:  for H1,H2 being Element of Cosets N holds
    LCL1.(H1,H2) = H1 * H2 and
    A2:  for H1,H2 being Element of Cosets N holds
    LCL2.(H1,H2) = H1 * H2;
    for H1,H2 being Element of Cosets N holds LCL1.(H1,H2) = LCL2.(H1,H2)
    proof
      let H1,H2 be Element of Cosets N;
      LCL1.(H1,H2) = H1 * H2 by A1
      .= LCL2.(H1,H2) by A2;
      hence thesis;
    end;
    hence thesis by BINOP_1:def 21;
  end;
end;

definition
  let Q;
  let N be normal SubLoop of Q;
  func Q _/_ N -> strict multLoop means
  :DefQuotientLoop:
  the carrier of it = Cosets N
  & the OneF of it = SubLoop_As_Coset N
  & the multF of it = Coset_Loop_Op N;
  existence
  proof
    set QN = multLoopStr(#Cosets N,Coset_Loop_Op N,SubLoop_As_Coset N#);
    for H being Element of QN holds H * 1.QN = H & 1.QN * H = H
    proof
      let H be Element of QN;
      H in Cosets N;
      then consider x being Element of Q such that
      Hx: H = x * N by DefCosets;
      L1a: H * 1.QN = H
      proof
        reconsider H as Element of Cosets N;
        (the multF of QN).(H,1.QN) = H * (1.Q * N) by DefCosetLoopOp,DefSubLoopAsCoset
        .= (x * N) * (1.Q * N) by Hx
        .= (x * 1.Q) * N by Defnormal
        .= H by Hx;
        hence thesis;
      end;
      L1b: 1.QN * H = H
      proof
        reconsider H as Element of Cosets N;
        (the multF of QN).(1.QN,H) = (1.Q * N) * H by DefCosetLoopOp,DefSubLoopAsCoset
        .= (1.Q * N) * (x * N) by Hx
        .= (1.Q * x) * N by Defnormal
        .= H by Hx;
        hence thesis;
      end;
      hence thesis by L1a;
    end;
    then L1: QN is well-unital;
    L2a: for H1,H2 being Element of QN holds ex H3 being Element of QN st H1 * H3 = H2
    proof
      let H1,H2 be Element of QN;
      H1 in Cosets N;
      then consider x being Element of Q such that
      Hx: H1 = x * N by DefCosets;
      H2 in Cosets N;
      then consider y being Element of Q such that
      Hy: H2 = y * N by DefCosets;
      reconsider H3 = (x \ y) * N as Element of QN by DefCosets;
      take H3;
      (the multF of QN).(H1,H3) = (x * N) * ((x \ y) * N) by Hx,DefCosetLoopOp
      .= (x * (x \ y)) * N by Defnormal
      .= y * N
      .= H2 by Hy;
      hence thesis;
    end;
    for H1,H2 being Element of QN holds ex H3 being Element of QN st H3 * H1 = H2
    proof
      let H1,H2 be Element of QN;
      H1 in Cosets N;
      then consider x being Element of Q such that
      Hx: H1 = x * N by DefCosets;
      H2 in Cosets N;
      then consider y being Element of Q such that
      Hy: H2 = y * N by DefCosets;
      reconsider H3 = (y / x) * N as Element of QN by DefCosets;
      take H3;
      (the multF of QN).(H3,H1) = ((y / x) * N) * (x * N) by Hx,DefCosetLoopOp
      .= ((y / x) * x) * N by Defnormal
      .= y * N
      .= H2 by Hy;
      hence thesis;
    end;
    then L2: QN is invertible by ALGSTR_1:def 6,L2a;
    for H1 being Element of QN holds H1 is left_mult-cancelable
    proof
      let H1 be Element of QN;
      for H2,H3 being Element of QN st H1*H2 = H1*H3 holds H2 = H3
      proof
        let H2,H3 be Element of QN;
        H1 in Cosets N;
        then consider x being Element of Q such that
        Hx: H1 = x * N by DefCosets;
        H2 in Cosets N;
        then consider y being Element of Q such that
        Hy: H2 = y * N by DefCosets;
        H3 in Cosets N;
        then consider z being Element of Q such that
        Hz: H3 = z * N by DefCosets;
        assume A: H1*H2 = H1*H3;
        (x*N)*(y*N) = H1 * H2 by Hx,Hy,DefCosetLoopOp
        .= H1 * H3 by A
        .= (x*N)*(z*N) by Hx,Hz,DefCosetLoopOp;
        then y * N = z * N by Defnormal;
        hence thesis by Hy,Hz,DefCosetLoopOp;
      end;
      hence thesis by ALGSTR_0:def 20;
    end;
    then L3a: QN is left_mult-cancelable by ALGSTR_0:def 23;
    for H1 being Element of QN holds H1 is right_mult-cancelable
    proof
      let H1 be Element of QN;
      for H2,H3 being Element of QN st H2*H1 = H3*H1 holds H2 = H3
      proof
        let H2,H3 be Element of QN;
        H1 in Cosets N;
        then consider x being Element of Q such that
        Hx: H1 = x * N by DefCosets;
        H2 in Cosets N;
        then consider y being Element of Q such that
        Hy: H2 = y * N by DefCosets;
        H3 in Cosets N;
        then consider z being Element of Q such that
        Hz: H3 = z * N by DefCosets;
        assume A: H2*H1 = H3*H1;
        (y*N)*(x*N) = H2 * H1 by Hx,Hy,DefCosetLoopOp
        .= H3 * H1 by A
        .= (z*N)*(x*N) by Hx,Hz,DefCosetLoopOp;
        then y * N = z * N by Defnormal;
        hence thesis by Hy,Hz,DefCosetLoopOp;
      end;
      hence thesis by ALGSTR_0:def 21;
    end;
    then QN is right_mult-cancelable by ALGSTR_0:def 24;
    then L3: QN is cancelable by ALGSTR_0:def 22,L3a;
    reconsider QN as strict multLoop by L1,L2,L3;
    take QN;
    thus thesis;
  end;
  uniqueness;
end;

definition
  let Q;
  let N be normal SubLoop of Q;
  func QuotientHom(Q,N) -> homomorphic Function of Q,Q _/_ N means
  :DefQuotientHom:
  for x holds it.(x) = x * N;
  existence
  proof
    deffunc F(Element of Q) = $1 * N;
    consider f be Function of Q,bool the carrier of Q
    such that
    Hf: for x being Element of Q holds f.x = F(x)
    from FUNCT_2:sch 4;
    Lfd: dom f = the carrier of Q by FUNCT_2:def 1;
    Lfr: rng f c= the carrier of Q _/_ N
    proof
      let H be object;
      assume H in rng f;
      then consider x being object such that
      Hx: x in dom f & H = f.x by FUNCT_1:def 3;
      x in the carrier of Q by Hx,Lfd;
      then reconsider x as Element of Q;
      H = f.x by Hx
      .= x * N by Hf;
      then H in Cosets N by DefCosets;
      hence thesis by DefQuotientLoop;
    end;
    reconsider f as Function of Q,Q _/_ N by FUNCT_2:2,Lfd,Lfr;
    f is homomorphic
    proof
      Hom1: f.(1.Q) = the OneF of Q _/_ N
      proof
        f.(1.Q) = 1.Q * N by Hf
        .= SubLoop_As_Coset N by DefSubLoopAsCoset
        .= (the OneF of Q _/_ N) by DefQuotientLoop;
        hence thesis;
      end;
      for x,y being Element of Q holds f.(x * y) = (f.x) * (f.y)
      proof
        let x,y be Element of Q;
        reconsider xN = x * N as Element of Cosets N by DefCosets;
        reconsider yN = y * N as Element of Cosets N by DefCosets;
        f.(x * y) = (x * y) * N by Hf
        .= (x * N) * (y * N) by Defnormal
        .= (Coset_Loop_Op N).(xN,yN) by DefCosetLoopOp
        .= (the multF of Q _/_ N).(xN,yN) by DefQuotientLoop
        .= (the multF of Q _/_ N).(f.x,yN) by Hf
        .= (the multF of Q _/_ N).(f.x,f.y) by Hf;
        hence thesis;
      end;
      hence thesis by Defhom,Hom1;
    end;
    then reconsider f as homomorphic Function of Q,Q _/_ N;
    take f;
    thus thesis by Hf;
  end;
  uniqueness
  proof
    let f,g be homomorphic Function of Q,Q _/_ N such that
    Hf: for x holds f.(x) = x * N
    and
    Hg: for x holds g.(x) = x * N;
    for x holds f.(x) = g.(x)
    proof
      let x;
      f.(x) = x * N by Hf
      .= g.(x) by Hg;
      hence thesis;
    end;
    hence thesis by FUNCT_2:def 8;
  end;
end;

:: Everything above checks and is relatively stable.
:: I am still working on the part after this.

::$V+
::$P+

:: PLEASE IMPROVE: This was ridiculously difficult to prove, so I am probably missing something.
theorem SubLoopOpEq:
  for H being SubLoop of Q holds
  for x,y holds
  for x1,y1 being Element of H st
  x = x1 & y = y1
  holds
  x * y = x1 * y1
proof
  let H be SubLoop of Q;
  let x,y;
  let x1,y1 be Element of H;
  assume H1: x = x1 & y = y1;
::  H2: (the multF of Q)||the carrier of H = (the multF of Q) | [: the carrier of H,the carrier of H :] by REALSET1:def 2;
  [x1,y1] in [: the carrier of H,the carrier of H :];
  then Hxy1: [x1,y1] in dom ((the multF of Q) | [: the carrier of H,the carrier of H :]);
::>                                                                                    *4
  :: the multF of H = (the multF of Q)||the carrier of H by SubL
  :: .= (the multF of Q) | [: the carrier of H,the carrier of H :] by REALSET1:def 2;
  :: then MM: the multF of H = (the multF of Q) | [: the carrier of H,the carrier of H :];
  set z1 = ((the multF of Q) | [: the carrier of H,the carrier of H :]).(x1,y1);
  x1 * y1 = ((the multF of Q)||the carrier of H).(x1,y1) by SubL
  .= ((the multF of Q) | [: the carrier of H,the carrier of H :]).(x1,y1) by REALSET1:def 2
  .= ((the multF of Q) | [: the carrier of H,the carrier of H :]).[x1,y1] by BINOP_1:def 1
  .= (the multF of Q).[x1,y1] by FUNCT_1:47,Hxy1
  .= x * y by H1;
  hence thesis;
end;

theorem SubLoopOpClosed:
  for H being SubLoop of Q holds
  for x,y st x in the carrier of H & y in the carrier of H holds x * y in the carrier of H
proof
  let H be SubLoop of Q;
  the multF of H = (the multF of Q)||the carrier of H by SubL
  .= (the multF of Q) | [: the carrier of H,the carrier of H :] by REALSET1:def 2;
  then the multF of H = (the multF of Q)||the carrier of H by SubL;
  let x,y;
  assume that
  Hx: x in the carrier of H
  and
  Hy: y in the carrier of H;
  reconsider x1 = x as Element of H by Hx,SUBSET:1;
  reconsider y1 = y as Element of H by Hy,SUBSET:1;
  x * y = (the multF of Q).(x,y);
  x1 * y1 = (the multF of H).(x1,y1);
  x * y = x1 * y1 by MM;
::>                   *144
  hence thesis;
end;

theorem NormalMlt:
  for N being normal SubLoop of Q holds
  for f being Function of Q,Q st f in Mlt (@ ([#] N)) holds
  for x st x in (@ ([#] N)) holds f.x in (@ ([#] N))
proof
  let N be normal SubLoop of Q;
  reconsider H = @ ([#] N) as Subset of Q;
  defpred P[Function of Q,Q] means for x st x in H holds $1.x in H;
  deffunc Phi(Subset of Funcs(the carrier of Q,the carrier of Q)) = MltClos1(H,$1);
  consider phi be Function of bool Funcs(the carrier of Q,the carrier of Q),bool Funcs(the carrier of Q,the carrier of Q)
  such that
  H1: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = Phi(X)
  from FUNCT_2:sch 4;
  H1b: for X being Subset of Funcs(the carrier of Q,the carrier of Q) holds phi.X = MltClos1(H,X) by H1;
  H2: for S be Subset of Funcs(the carrier of Q,the carrier of Q) st phi.S c= S holds Mlt H c= S
  by MltLFP,H1b;
  set SP = {f where f is Function of Q,Q : P[f]};
  SP c= Funcs(the carrier of Q,the carrier of Q)
  proof
    let f be object;
    assume f in SP;
    then consider g being Function of Q,Q such that
    K3a: f = g & P[g];
    thus thesis by FUNCT_2:9,K3a;
  end;
  then reconsider SP as Subset of Funcs(the carrier of Q,the carrier of Q) by SUBSET:3;
  phi.(SP) c= SP
  proof
    let f be object;
    assume f in phi.(SP);
    then f in MltClos1(H,SP) by H1;
    then (ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u)) 
    or
    (ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u))
    or
    (ex g,h be Permutation of the carrier of Q st g in SP & h in SP & f = g*h)
    or
    (ex g be Permutation of the carrier of Q st g in SP & f = g") by DefMltClos1;
    then per cases;
    suppose ex u be Element of Q st u in H & f = (curry' (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hf1: u in H & f = (curry' (the multF of Q)).(u);
      Hf2: f in Funcs(the carrier of Q,the carrier of Q) by Hf1;
      then reconsider f as Function of Q,Q by FUNCT_2:66;
      P[f]
      proof
        let x;
        assume x in H;
        then reconsider xn = x as Element of N;
        reconsider un = u as Element of N by Hf1;
        HN: xn in the carrier of N & un in the carrier of N;
        f.x = x * u by FUNCT_5:70,Hf1
        .= (the multF of Q).(xn,un)
        .= (the multF of N).(xn,un) by MM,REALSET1:def 1,HN;
::>                                     *144
        hence thesis;
      end;
      hence thesis by Hf2;
    end;
    suppose ex u be Element of Q st u in H & f = (curry (the multF of Q)).(u);
      then consider u being Element of Q such that
      Hf1: u in H & f = (curry (the multF of Q)).(u);
      Hf2: f in Funcs(the carrier of Q,the carrier of Q) by Hf1;
      then reconsider f as Function of Q,Q by FUNCT_2:66;
      P[f]
      proof
        thus thesis;
::>               *4
      end;
      hence thesis by Hf2;
    end;
    suppose ex g,h be Permutation of the carrier of Q st g in SP & h in SP & f = g*h;
      then consider g,h being Permutation of the carrier of Q such that
      Hgh: g in SP & h in SP & f = g*h;
      f is Permutation of the carrier of Q by Hgh;
      hence thesis;
::>              *4
    end;
    suppose ex g be Permutation of the carrier of Q st g in SP & f = g";
      then consider g being Permutation of the carrier of Q such that
      Hg: g in SP & f = g";
      f is Permutation of the carrier of Q by Hg;
      hence thesis;
::>              *4
    end;
  end;
  then H3: Mlt H c= SP by H2;
  let f be Permutation of the carrier of Q;
::>                                 *56
  assume f in Mlt (@ ([#] N));
  then f in SP by H3;
  then consider g being Function of Q,Q such that
  Hg: f = g & P[g];
  thus thesis by Hg;
end;

theorem NormalSubLoopIsCoset:
  for N being normal SubLoop of Q holds
  the carrier of N = 1.Q * N
proof
  let N be normal SubLoop of Q;
  NH: the carrier of N c= the carrier of Q by SubL;
  thus the carrier of N c= 1.Q * N
  proof
    let x be object;
    assume Hx: x in the carrier of N;
    then x in the carrier of Q by NH;
    then reconsider x as Element of Q;
    LM1: (curry (the multF of Q)).(x) in Mlt (@ ([#] N)) by MltL,Hx;
    reconsider h = (curry (the multF of Q)).(x) as Permutation of the carrier of Q by MltLPerm;
    LM2: h in Mlt (@ [#] N) by LM1;
    LM3: h.(1.Q) in 1.Q * (@ ([#] N)) by DefSubsetCoset,LM2;
    h.(1.Q) = x * 1.Q by FUNCT_5:69;
    then h.(1.Q) = x;
    then x in 1.Q * (@ ([#] N)) by LM2,LM3;
    hence thesis by DefSubLoopCoset;
  end;
  thus 1.Q * N c= the carrier of N
  proof
    let x be object;
    assume x in 1.Q * N;
    then x in 1.Q * (@ [#] N) by DefSubLoopCoset;
    then consider h being Permutation of the carrier of Q such that
    Hh: h in Mlt (@ [#] N) & x = h.(1.Q) by DefSubsetCoset;
    1.N = 1.Q by SubL;
    then 1.Q is Element of N;
    then 1.Q in the carrier of N;
    hence thesis by NormalMlt,Hh;
  end;
end;

theorem KerQuotientHom:
  for N being normal SubLoop of Q holds
  Ker (QuotientHom(Q,N)) = the carrier of N
proof
  let N be normal SubLoop of Q;
  set f = QuotientHom(Q,N);
  thus Ker f c= the carrier of N
  proof
    let x be object;
    assume Hx: x in Ker f;
    then reconsider x as Element of Q by DefKer;
    x * N = f.x by DefQuotientHom
    .= 1.(Q _/_ N) by DefKer,Hx
    .= SubLoop_As_Coset N by DefQuotientLoop
    .= 1.Q * N by DefSubLoopAsCoset;
    then A: x * N = 1.Q * N;
    1.N = 1.Q by SubL;
    then 1.Q is Element of N;
    then 1.Q in the carrier of N;
    then LM1: (curry (the multF of Q)).(1.Q) in Mlt (@ ([#] N)) by MltL;
    reconsider h = (curry (the multF of Q)).(1.Q) as Permutation of the carrier of Q by MltLPerm;
    LM2: h in Mlt (@ [#] N) by LM1;
    LM3: h.(x) in x * (@ ([#] N)) by DefSubsetCoset,LM2;
    h.(x) = 1.Q * x by FUNCT_5:69;
    then h.(x) = x;
    then x in x * (@ ([#] N)) by LM2,LM3;
    then x in x * N by DefSubLoopCoset;
    then x in 1.Q * N by A;
    then x in 1.Q * (@ ([#] N)) by DefSubLoopCoset;
    then consider g being Permutation of the carrier of Q such that
    Hg: g in Mlt (@ ([#] N)) & x = g.(1.Q) by DefSubsetCoset;

thus thesis;
::>           *4
  end;
  thus the carrier of N c= Ker f
  proof
    thus thesis;
::>           *4
  end;
end;

::$V-
::$P-

:: old:

theorem CosetOpHom:
  for H be normal SubLoop of Q holds
  (x * (@ [#]H)) * (y * (@ [#]H)) = (x * y) * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (@[#]H) is normal by Defnormal;
    hence thesis by DefnormalS;
  end;
  
theorem CosetOpHomLId:
  for H be normal SubLoop of Q holds
  (1.Q * (@ [#]H)) * (x * (@ [#]H)) = x * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (1.Q * (@ [#]H)) * (x * (@ [#]H))
    = (1.Q * x) * (@ [#]H) by CosetOpHom
    .= x * (@ [#]H);
    hence thesis;
  end;
  
theorem CosetOpHomRId:
  for H be normal SubLoop of Q holds
  (x * (@ [#]H)) * (1.Q * (@ [#]H)) = x * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (x * (@ [#]H)) * (1.Q * (@ [#]H))
    = (x * 1.Q) * (@ [#]H) by CosetOpHom
    .= x * (@ [#]H);
    hence thesis;
  end;
  
theorem CosetOpHomB2:
  for H be normal SubLoop of Q holds
  (x * (@ [#]H)) * ((x \ y) * (@ [#]H)) = y * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (x * (@ [#]H)) * ((x \ y) * (@ [#]H))
    = (x * (x \ y)) * (@ [#]H) by CosetOpHom
    .= y * (@ [#]H);
    hence thesis;
  end;
  
theorem CosetOpHomS2:
  for H be normal SubLoop of Q holds
  ((x / y) * (@ [#]H)) * (y * (@ [#]H)) = x * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    ((x / y) * (@ [#]H)) * (y * (@ [#]H))
    = ((x / y) * y) * (@ [#]H) by CosetOpHom
    .= x * (@ [#]H);
    hence thesis;
  end;
  
theorem CosetOpHomCancelL:
  for H be normal SubLoop of Q st
  (x * (@ [#]H)) * (z * (@ [#]H)) = (y * (@ [#]H)) * (z * (@ [#]H))
  holds
  x * (@ [#]H) = y * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (@[#]H) is normal by Defnormal;
    hence thesis by DefnormalS;
  end;
  
theorem CosetOpHomCancelR:
  for H be normal SubLoop of Q st
  (z * (@ [#]H)) * (x * (@ [#]H)) = (z * (@ [#]H)) * (y * (@ [#]H))
  holds
  x * (@ [#]H) = y * (@ [#]H)
  proof
    let H be normal SubLoop of Q;
    (@[#]H) is normal by Defnormal;
    hence thesis by DefnormalS;
  end;
  
::> 4: This inference is not accepted
::> 56: Disagreement of types
::> 144: Unknown label