reserve n,k for Element of NAT;

theorem Th13:
  for L be distributive finite LATTICE ex r be Function of L,
InclPoset LOWER(subrelstr Join-IRR L) st r is isomorphic & for a being Element
  of L holds r.a= downarrow a /\ Join-IRR L
proof
  let L be distributive finite LATTICE;
  set I = InclPoset LOWER(subrelstr Join-IRR L);
  deffunc U(Element of L) = downarrow $1 /\ Join-IRR L;
  consider r be ManySortedSet of the carrier of L such that
A1: for d be Element of L holds r.d= U(d) from PBOOLE:sch 5;
A2: rng r c= the carrier of I
  proof
    let t be object;
    reconsider tt=t as set by TARSKI:1;
    assume t in rng r;
    then consider x be object such that
A3: x in dom r and
A4: t = r.x by FUNCT_1:def 3;
    reconsider x as Element of L by A3;
A5: t=downarrow x /\ Join-IRR L by A1,A4;
    then tt c= Join-IRR L by XBOOLE_1:17;
    then reconsider t as Subset of subrelstr Join-IRR L by YELLOW_0:def 15;
A6: t is lower
    proof
      let c,d be Element of subrelstr Join-IRR L;
      assume that
A7:   c in t and
A8:   d <= c;
A9:   d is Element of Join-IRR L by YELLOW_0:def 15;
A10:  Join-IRR L is non empty by A5,A7;
      then d in Join-IRR L by A9;
      then reconsider c1=c,d1=d as Element of L by A5,A7;
      c in downarrow x by A5,A7,XBOOLE_0:def 4;
      then
A11:  c1 <= x by WAYBEL_0:17;
      d1 <= c1 by A8,YELLOW_0:59;
      then d1 <= x by A11,ORDERS_2:3;
      then d1 in downarrow x by WAYBEL_0:17;
      hence thesis by A5,A10,A9,XBOOLE_0:def 4;
    end;
    the carrier of I = LOWER(subrelstr Join-IRR L) by YELLOW_1:1;
    hence thesis by A6;
  end;
  dom r = the carrier of L by PARTFUN1:def 2;
  then reconsider r as Function of L,I by A2,FUNCT_2:def 1,RELSET_1:4;
A12: for x,y being Element of L holds (x <= y iff r.x <= r.y)
  proof
    let x,y be Element of L;
    thus x <= y implies r.x <= r.y
    proof
      assume
A13:  x <= y;
      downarrow x /\ Join-IRR L c= downarrow y /\ Join-IRR L
      proof
        let a be Element of L;
        assume a in downarrow x /\ Join-IRR L;
        then
A14:    a in downarrow x & a in Join-IRR L by XBOOLE_0:def 4;
        downarrow x c= downarrow y by A13,WAYBEL_0:21;
        hence thesis by A14,XBOOLE_0:def 4;
      end;
      then r.x c= downarrow y /\ Join-IRR L by A1;
      then r.x c= r.y by A1;
      hence thesis by YELLOW_1:3;
    end;
    thus r.x <= r.y implies x <= y
    proof
      r.x= downarrow x /\ Join-IRR L & r.y= downarrow y /\ Join-IRR L by A1;
      then reconsider rx = r.x,ry= r.y as Subset of L;
      assume r.x <= r.y;
      then
A15:  rx c= ry by YELLOW_1:3;
      ex_sup_of rx,L & ex_sup_of ry,L by YELLOW_0:17;
      then sup(rx) <= sup(ry) by A15,YELLOW_0:34;
      then sup (downarrow x /\ Join-IRR L) <= sup (ry) by A1;
      then sup (downarrow x /\ Join-IRR L) <= sup (downarrow y /\ Join-IRR L)
      by A1;
      then x <= sup (downarrow y /\ Join-IRR L) by Th12;
      hence thesis by Th12;
    end;
  end;
  the carrier of I c= rng r
  proof
    let x be object;
    assume
A16: x in the carrier of I;
    thus x in rng r
    proof
      x in LOWER(subrelstr Join-IRR L) by A16,YELLOW_1:1;
      then consider X being Subset of subrelstr Join-IRR L such that
A17:  x=X and
A18:  X is lower;
      the carrier of subrelstr Join-IRR L c= Join-IRR L by YELLOW_0:def 15;
      then the carrier of subrelstr Join-IRR L c= the carrier of L by
XBOOLE_1:1;
      then reconsider X1=X as Subset of L by XBOOLE_1:1;
      ex y being set st y in dom r & x = r.y
      proof
        take y = sup X1;
        dom r = the carrier of L by FUNCT_2:def 1;
        hence y in dom r;
A19:    downarrow(sup X1) /\ Join-IRR L c= X1
        proof
          let r be Element of L;
          reconsider r1=r as Element of L;
          assume
A20:      r in downarrow(sup X1) /\ Join-IRR L;
          then r in downarrow(sup X1) by XBOOLE_0:def 4;
          then
A21:      r1 <= sup X1 by WAYBEL_0:17;
          per cases;
          suppose
            r1 in X1;
            hence thesis;
          end;
          suppose
A22:        not r1 in X1;
A23:        r1 in Join-IRR L by A20,XBOOLE_0:def 4;
            then consider z be Element of L such that
A24:        z < r1 and
A25:        for y be Element of L st y < r1 holds y <= z by Th11;
            {r1} "/\" X1 is_<=_than z
            proof
              let a be Element of L;
A26:          r1 in the carrier of subrelstr Join-IRR L by A23,YELLOW_0:def 15;
              assume a in {r1} "/\" X1;
              then a in {r1"/\"k where k is Element of L:k in X1} by
YELLOW_4:42;
              then consider x be Element of L such that
A27:          a=r1"/\"x and
A28:          x in X1;
              reconsider r9=r1,x9=x as Element of subrelstr Join-IRR L by A23
,A28,YELLOW_0:def 15;
A29:          ex_inf_of {r1,x},L by YELLOW_0:17;
              then
A30:          a <= x by A27,YELLOW_0:19;
A31:          a <> r1 by A18,A22,A28,A30,A26,YELLOW_0:60;
              a <= r1 by A27,A29,YELLOW_0:19;
              then a < r1 by A31,ORDERS_2:def 6;
              hence thesis by A25;
            end;
            then
A32:        sup ({r1} "/\" X1) <= z by YELLOW_0:32;
            r1 = r1 "/\" sup X1 & r1 "/\" sup X1 = sup ({r1} "/\" X1) by A21,
WAYBEL_2:15,YELLOW_0:25;
            hence thesis by A24,A32,ORDERS_2:7;
          end;
        end;
        X1 c= downarrow(sup X1) /\ Join-IRR L
        proof
          let a be Element of L;
          assume
A33:      a in X1;
          set A = a;
          ex_sup_of X1,L by YELLOW_0:17;
          then
A34:      X1 is_<=_than "\/"(X1,L) by YELLOW_0:def 9;
          ex y being Element of L st y in {sup X1} & A <= y
          proof
            take y = sup X1;
            thus y in {sup X1} by TARSKI:def 1;
            thus thesis by A33,A34;
          end;
          then
A35:      A in downarrow {sup X1} by WAYBEL_0:def 15;
          X is Subset of Join-IRR L by YELLOW_0:def 15;
          hence a in downarrow(sup X1) /\ Join-IRR L by A33,A35,XBOOLE_0:def 4;
        end;
        then X1 = downarrow(sup X1) /\ Join-IRR L by A19,XBOOLE_0:def 10;
        hence x=r.y by A1,A17;
      end;
      hence thesis by FUNCT_1:def 3;
    end;
  end;
  then
A36: rng r = the carrier of I by XBOOLE_0:def 10;
  r is one-to-one
  proof
    let x,y be Element of L;
    r.y= downarrow y /\ Join-IRR L by A1;
    then reconsider ry= r.y as Subset of L;
    assume r.x = r.y;
    then sup (downarrow x /\ Join-IRR L) = sup (ry) by A1;
    then sup (downarrow x /\ Join-IRR L) = sup (downarrow y /\ Join-IRR L) by
A1;
    then x = sup (downarrow y /\ Join-IRR L) by Th12;
    hence thesis by Th12;
  end;
  then r is isomorphic by A36,A12,WAYBEL_0:66;
  hence thesis by A1;
end;
