View difference between Paste ID: zMBRyvgR and b5c0xZuW

 program sfdsf;
 
 {$APPTYPE CONSOLE}
 
 uses
   SysUtils;
 
 type
   triplet = record
     a, b, c: integer;
     s: string;
   end;
 
 var
   f, i, k, n, j: integer;
   s, s1, s2: string;
   b, b1, b2: boolean;
   a: array [1..100000] of triplet;
 
 procedure swap(var a, b: triplet);
 var
   c: triplet;
 begin
   c := a;
   a := b;
   b := c;
 end;
 
 function fff(s, s1: string): boolean;
 var
   i: integer;
 begin
   for i := 1 to 3 do
     if(ord(s[i]) < ord(s1[i])) then
     begin
       fff := true;
       exit;
     end;
   fff := false;
 end;
 
 begin
   readln(n);
   k := 0;
   for j := 1 to n do
   begin
     readln(s);
     b := false;
     b1 := false;
     b2 := false;
     s1 := s[5] + s[6] + s[7];
     s2 := s[9] + s[10] + s[11];
     s := s[1] + s[2] + s[3];
     for i := 1 to k do
     begin
       if (s = a[i].s) then
       begin
         inc(a[i].a);
         b := true;
       end;
       if (s1 = a[i].s) then
       begin
         inc(a[i].b);
         b1 := true;
       end;
       if (s2 = a[i].s) then
       begin
         inc(a[i].c);
         b2 := true;
       end;
     end;
     if (not b) then
     begin
       inc(k);
       a[k].s := s;
       a[k].a := 1;
     end;
     if (not b1) then
     begin
       if(s1 <> a[k].s) then inc(k);
       a[k].s := s1;
       inc(a[k].b);
     end;
     if (not b2) then
     begin
       if(s2 = a[k - 1].s) then inc(a[k-1].c)
       else if (s2 = a[k].s) then inc(a[k].c)
       else
       begin
         inc(k);
         a[k].s := s2;
         a[k].c := 1;
       end;
     end;
   end;
   for i := 1 to k do
     for j := 1 to k do
       if (a[j].a > a[j + 1].a) then swap(a[j], a[j + 1])
         else if (a[j].a = a[j + 1].a) and (a[j].b > a[j + 1].b) then swap(a[j], a[j + 1])
           else if (a[j].a = a[j + 1].a) and (a[j].b = a[j + 1].b) and (a[j].c > a[j + 1].c) then swap(a[j], a[j + 1])
             else if (a[j].a = a[j + 1].a) and (a[j].b = a[j + 1].b) and (a[j].c = a[j + 1].c) and (fff(a[j].s, a[j + 1].s)) then swap(a[j], a[j + 1]);
   for i := k + 1 downto 2 do writeln(a[i].s, ' ', a[i].a, ' ', a[i].b, ' ', a[i].c);
 end.