reserve C for CategoryStr;
reserve f,f1,f2,f3 for morphism of C;
reserve g1,g2 for morphism of C opp;
reserve C,D,E for with_identities CategoryStr;
reserve F for Functor of C,D;
reserve G for Functor of D,E;
reserve f for morphism of C;

theorem
  ex C,D being category, F being Functor of C,D st
  F is multiplicative & F is non identity-preserving
  proof
    set C = the non empty category;
    reconsider X = {0,1} as set;
    set comp = {[[0,0],0],[[1,1],1]} \/ {[[0,1],1],[[1,0],1]};
A1: for x being object holds x in comp iff
    (x = [[0,0],0] or x = [[1,1],1] or x = [[0,1],1] or x = [[1,0],1])
    proof
      let x be object;
      thus x in comp implies
      (x = [[0,0],0] or x = [[1,1],1] or x = [[0,1],1] or x = [[1,0],1])
      proof
        assume x in comp;
        then x in {[[0,0],0],[[1,1],1]} or
        x in {[[0,1],1],[[1,0],1]} by XBOOLE_0:def 3;
        hence thesis by TARSKI:def 2;
      end;
      assume x = [[0,0],0] or x = [[1,1],1] or x = [[0,1],1] or x = [[1,0],1];
      then x in {[[0,0],0],[[1,1],1]} or
      x in {[[0,1],1],[[1,0],1]} by TARSKI:def 2;
      hence x in comp by XBOOLE_0:def 3;
    end;
A2: for x,y1,y2 being object st [x,y1] in comp & [x,y2] in comp holds y1 = y2
    proof
      let x,y1,y2 be object;
      assume
A3:  [x,y1] in comp;
      assume
A4:  [x,y2] in comp;
      per cases by A3,A1;
      suppose
A5:    [x,y1] = [[0,0],0];
        then
A6:     x = [0,0] & y1 = 0 by XTUPLE_0:1;
        per cases by A4,A1;
        suppose [x,y2] = [[0,0],0];
          hence thesis by A5,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[1,1],1];
          then x = [1,1] & y2 = 1 by XTUPLE_0:1;
          hence thesis by A6,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[0,1],1];
          then x = [0,1] & y2 = 1 by XTUPLE_0:1;
          hence thesis by A6,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[1,0],1];
          then x = [1,0] & y2 = 1 by XTUPLE_0:1;
          hence thesis by A6,XTUPLE_0:1;
        end;
      end;
      suppose [x,y1] = [[1,1],1];
        then
A7:     x = [1,1] & y1 = 1 by XTUPLE_0:1;
        per cases by A4,A1;
        suppose [x,y2] = [[0,0],0];
          then x = [0,0] & y2 = 0 by XTUPLE_0:1;
          hence thesis by A7,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[1,1],1] or [x,y2] = [[0,1],1] or [x,y2] = [[1,0],1];
          hence thesis by A7,XTUPLE_0:1;
        end;
      end;
      suppose [x,y1] = [[0,1],1];
        then
A8:     x = [0,1] & y1 = 1 by XTUPLE_0:1;
        per cases by A4,A1;
        suppose [x,y2] = [[0,0],0];
          then x = [0,0] & y2 = 0 by XTUPLE_0:1;
          hence thesis by A8,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[1,1],1] or [x,y2] = [[0,1],1] or [x,y2] = [[1,0],1];
          hence thesis by A8,XTUPLE_0:1;
        end;
      end;
      suppose [x,y1] = [[1,0],1];
        then
A9:     x = [1,0] & y1 = 1 by XTUPLE_0:1;
        per cases by A4,A1;
        suppose [x,y2] = [[0,0],0];
          then x = [0,0] & y2 = 0 by XTUPLE_0:1;
          hence thesis by A9,XTUPLE_0:1;
        end;
        suppose [x,y2] = [[1,1],1] or [x,y2] = [[0,1],1] or [x,y2] = [[1,0],1];
          hence thesis by A9,XTUPLE_0:1;
        end;
      end;
    end;
    for x being object st x in comp holds x in [:[:X,X:],X:]
    proof
      let x be object;
      assume
A10:  x in comp;
      per cases by A10,A1;
      suppose
A11:     x = [[0,0],0];
A12:    0 in X by TARSKI:def 2;
        then [0,0] in [:X,X:] by ZFMISC_1:def 2;
        hence x in [:[:X,X:],X:] by A11,A12,ZFMISC_1:def 2;
      end;
      suppose
A13:     x = [[1,1],1];
A14:    1 in X by TARSKI:def 2;
        then [1,1] in [:X,X:] by ZFMISC_1:def 2;
        hence x in [:[:X,X:],X:] by A13,A14,ZFMISC_1:def 2;
      end;
      suppose
A15:     x = [[0,1],1];
A16:    0 in X & 1 in X by TARSKI:def 2;
        then [0,1] in [:X,X:] by ZFMISC_1:def 2;
        hence x in [:[:X,X:],X:] by A15,A16,ZFMISC_1:def 2;
      end;
      suppose
A17:     x = [[1,0],1];
A18:    0 in X & 1 in X by TARSKI:def 2;
        then [1,0] in [:X,X:] by ZFMISC_1:def 2;
        hence x in [:[:X,X:],X:] by A17,A18,ZFMISC_1:def 2;
      end;
    end;
    then reconsider comp as PartFunc of [:X,X:],X
    by A2,TARSKI:def 3,FUNCT_1:def 1;
    set D = CategoryStr(# X, comp #);
A19: for f1,f2 being morphism of D st f1 |> f2 holds
    (f1 = 0 & f2 = 0 & f1(*)f2 = 0) or
    (f1 = 1 & f2 = 1 & f1(*)f2 = 1) or
    (f1 = 0 & f2 = 1 & f1(*)f2 = 1) or
    (f1 = 1 & f2 = 0 & f1(*)f2 = 1)
    proof
      let f1,f2 be morphism of D;
      assume
A20:   f1 |> f2;
      assume
A21:   not (f1 = 0 & f2 = 0 & f1(*)f2 = 0) &
      not (f1 = 1 & f2 = 1 & f1(*)f2 = 1) &
      not (f1 = 0 & f2 = 1 & f1(*)f2 = 1);
      consider y be object such that
A22: [[f1,f2],y] in the composition of D by A20,XTUPLE_0:def 12;
A23:   f1(*)f2 = (the composition of D).(f1,f2) by Def3,A20
      .= (the composition of D).[f1,f2] by BINOP_1:def 1
      .= y by A22,FUNCT_1:1;
      per cases by A22,A1;
      suppose [[f1,f2],y] = [[0,0],0];
        then [f1,f2] = [0,0] & y = 0 by XTUPLE_0:1;
        hence thesis by A23,A21,XTUPLE_0:1;
      end;
      suppose [[f1,f2],y] = [[1,1],1];
        then [f1,f2] = [1,1] & y = 1 by XTUPLE_0:1;
        hence thesis by A21,A23,XTUPLE_0:1;
      end;
      suppose [[f1,f2],y] = [[0,1],1];
        then [f1,f2] = [0,1] & y = 1 by XTUPLE_0:1;
        hence thesis by A21,A23,XTUPLE_0:1;
      end;
      suppose [[f1,f2],y] = [[1,0],1];
        then [f1,f2] = [1,0] & y = 1 by XTUPLE_0:1;
        hence thesis by A23,XTUPLE_0:1;
      end;
    end;
A24: for f1,f2 being morphism of D holds f1 |> f2
    proof
      let f1,f2 be morphism of D;
      per cases by TARSKI:def 2;
      suppose (f1 = 0 & f2 = 0) or (f1 = 1 & f2 = 1) or (f1 = 0 & f2 = 1);
        then [[f1,f2],f2] in the composition of D by A1;
        hence thesis by FUNCT_1:1;
      end;
      suppose f1 = 1 & f2 = 0;
        then [[f1,f2],f1] in the composition of D by A1;
        hence thesis by FUNCT_1:1;
      end;
    end;
A25: D is left_composable by A24;
A26: for f,f1,f2 being morphism of D st f1 |> f2 holds
    f |> f1(*)f2 iff f |> f1 by A24;
A27: for f1 being morphism of D st f1 in the carrier of D holds
    ex f being morphism of D st f |> f1 & f is left_identity
    proof
      let f1 be morphism of D;
      assume f1 in the carrier of D;
      reconsider f = 0 as morphism of D by TARSKI:def 2;
      take f;
      thus f |> f1 by A24;
      for f2 being morphism of D st f |> f2 holds f (*) f2 = f2
      proof
        let f2 be morphism of D;
        assume
A28:     f |> f2;
        f2 = 0 or f2 = 1 by TARSKI:def 2;
        hence f (*) f2 = f2 by A28,A19;
      end;
      hence f is left_identity;
    end;
    for f1 being morphism of D st f1 in the carrier of D holds
    ex f being morphism of D st f1 |> f & f is right_identity
    proof
      let f1 be morphism of D;
      assume f1 in the carrier of D;
      reconsider f = 0 as morphism of D by TARSKI:def 2;
      take f;
      thus f1 |> f by A24;
      for f2 being morphism of D st f2 |> f holds f2 (*) f = f2
      proof
        let f2 be morphism of D;
        assume
A29:     f2 |> f;
        f2 = 0 or f2 = 1 by TARSKI:def 2;
        hence f2 (*) f = f2 by A29,A19;
      end;
      hence f is right_identity;
    end;
    then
A30: D is with_right_identities;
    for f1,f2,f3 being morphism of D st f1 |> f2 & f2 |> f3 &
    f1 (*) f2 |> f3 & f1 |> f2 (*) f3 holds
    f1 (*) (f2 (*) f3) = (f1 (*) f2) (*) f3
    proof
      let f1,f2,f3 be morphism of D;
      assume
A31:  f1 |> f2 & f2 |> f3;
      assume
A32:  f1 (*) f2 |> f3;
      assume
A33:  f1 |> f2 (*) f3;
      per cases by TARSKI:def 2;
      suppose
A34:     f3 = 0;
        per cases by TARSKI:def 2;
        suppose
A35:       f2 = 0;
          then
A36:       f2 (*) f3 = 0 by A34,A31,A19;
          per cases by TARSKI:def 2;
          suppose f1 = 0;
            hence f1(*)(f2(*)f3) = (f1(*)f2)(*)f3 by A36,A34,A35;
          end;
          suppose
A37:        f1 = 1;
            then
A38:        f1 (*) f2 = 1 by A31,A19;
            thus f1 (*) (f2 (*) f3) = 1 by A37,A33,A19
            .= (f1 (*) f2) (*) f3 by A32,A38,A19;
          end;
        end;
        suppose
A39:       f2 = 1;
          then f2 (*) f3 = 1 & f1 (*) f2 = 1  by A31,A19;
          hence f1 (*) (f2 (*) f3) = (f1 (*) f2) (*) f3 by A39;
        end;
      end;
      suppose
A40:     f3 = 1;
        then f2 (*) f3 = 1 by A31,A19;
        hence f1 (*) (f2 (*) f3) = 1 by A33,A19
        .= (f1 (*) f2) (*) f3 by A32,A40,A19;
      end;
    end;
    then reconsider D as category by A26,A27,A30,Def6,Def10,Def12,A25,Def9,
    Def11;
    take C,D;
    reconsider d1 = 1 as morphism of D by TARSKI:def 2;
    deffunc F1(object) = d1;
A41: for x being object st x in the carrier of C
    holds F1(x) in the carrier of D;
    consider F be Function of the carrier of C, the carrier of D such that
A42: for x being object st x in the carrier of C holds F.x = F1(x)
    from FUNCT_2:sch 2(A41);
    reconsider F as Functor of C, D;
    take F;
    for f1,f2 being morphism of C st f1 |> f2 holds
    F.f1 |> F.f2 & F.(f1 (*) f2) = (F .f1) (*) (F .f2)
    proof
      let f1,f2 be morphism of C;
      assume f1 |> f2;
      thus F.f1 |> F.f2 by A24;
      reconsider x1 = f1, x2  = f2, x12 = f1 (*) f2 as object;
A43:  F.f1 = F.x1 by Def21 .= d1 by A42;
A44:  F.f2 = F.x2 by Def21 .= d1 by A42;
A45:   d1 |> d1 by A24;
      thus F.(f1(*)f2) = F.x12 by Def21
      .= d1 by A42
      .= (F.f1)(*)(F.f2) by A43,A44,A45,A19;
    end;
    hence F is multiplicative;
    ex f being morphism of C st f is identity & not F.f is identity
    proof
      reconsider f = the Object of C as morphism of C by TARSKI:def 3;
      take f;
      thus f is identity by Th22;
      reconsider x = f as object;
A46:   F.f = F.x by Def21 .= d1 by A42;
      ex d0 being morphism of D st d1 |> d0 & not d1(*)d0 = d0
      proof
        reconsider d0 = 0 as morphism of D by TARSKI:def 2;
        take d0;
        thus d1 |> d0 by A24;
        hence not d1(*)d0 = d0 by A19;
      end;
      hence not F.f is identity by A46,Def4;
    end;
    hence F is non identity-preserving;
  end;
