2
ABCGRS
ACBGYV
2

There are only 6 available combinations.
Take a dice and think if you can make it so that 1 is adjacent to 6? 2 to 5? 3 to 4?

Can someone help to post test #2? Thanks

My program:

Program t1127;

Const P:array[1..24,1..6]of integer= {all combinations}
       ( (6,4,3,1,5,2),
         (3,5,4,1,6,2),
         (4,6,5,1,3,2),
         (5,3,6,1,4,2),
         (6,4,5,2,3,1),
         (3,5,6,2,4,1),
         (4,6,3,2,5,1),
         (5,3,4,2,6,1),
         (1,2,6,3,4,5),
         (6,4,2,3,1,5),
         (2,1,4,3,6,5),
         (4,6,1,3,2,5),
         (1,2,4,5,6,3),
         (6,4,1,5,2,3),
         (2,1,6,5,4,3),
         (4,6,2,5,1,3),
         (1,2,3,4,5,6),
         (3,5,2,4,1,6),
         (2,1,5,4,3,6),
         (5,3,1,4,2,6),
         (1,2,5,6,3,4),
         (3,5,1,6,2,4),
         (2,1,3,6,5,4),
         (5,3,2,6,1,4)  );
   MaxN=1000;

Var Cube      :array[1..MaxN,1..6]of char;
    Tmp       :array[1..6]of char;
    ACube     :array[1..MaxN,1..24]of string[4];
    yet       :array[1..MaxN,1..24]of boolean;
    N,i,j,k   :integer;
    max,ik,jk :integer;
    m         :integer;
    ch        :char;

begin
Read(n);
for i:=1 to N do
 for j:=1 to 6 do begin
  read(ch);
  while (ch=#10)or(ch=#13)or(ch=#32) do read(ch);
  Cube[i,j]:=ch;
 end;
for i:=1 to N do
 for j:=1 to 24 do begin
  for k:=1 to 6 do tmp[k]:=cube[i,p[j,k]];
  ACube[i,j]:='';
  ACube[i,j]:=tmp[1]+tmp[2]+tmp[3]+tmp[4];
 end;
m:=0;
for i:=1 to N do
 for j:=1 to 24 do
  yet[i,j]:=true;
for i:=1 to N do
 for j:=1 to 24 do if yet[i,j] then begin
  yet[i,j]:=false;
  max:=1;
  for ik:=1 to N do if ik<>i then
   for jk:=1 to 24 do
    if ((acube[i,j][1]=acube[ik,jk][1])and(acube[i,j][4]=acube[ik,jk]
[4]))or
       ((acube[i,j][1]=acube[ik,jk][4])and(acube[i,j][4]=acube[ik,jk]
[1])) then
    if ((acube[i,j][2]=acube[ik,jk][2])and(acube[i,j][3]=acube[ik,jk]
[3]))or
       ((acube[i,j][2]=acube[ik,jk][3])and(acube[i,j][3]=acube[ik,jk]
[2]))
       then begin
     yet[ik,jk]:=false;
     max:=max+1;
     break;
    end;
  if max>m then m:=max;
 end;
writeln(m);
end.

why WA 6, i search two pair, if pair=2, then count++
    #include <queue>
    #include <iostream>
    #include <set>
    #include <cstdio>
    #include <algorithm>
    #include <string>
    #include <map>
    #include <string>
    #include <stack>
    #include <sstream>

    using namespace std;
    typedef long long ll;
    typedef unsigned long long ull;
    typedef long double ld;
    char a[10000][6];
    void swap(char &a,char &b)
    {
        if(a>b)
        {
            char c;
            c=a;
            a=b;
            b=c;
        }
    }
    int amx(int a,int b)
    {
        if(a>b)
        {
            return(a);
        }
        else return (b);
    }
    int main()
    {
        int n;
        cin>>n;
        for(int i=0;i<n;i++)
        {
            cin>>a[i][0];
            cin>>a[i][2];
            cin>>a[i][3];
            cin>>a[i][1];
            cin>>a[i][4];
            cin>>a[i][5];
        }
        /*
        for(int i=0;i<n;i++)
        {
            for(int j=0;j<6;j++)
                cout<<a[i][j]<<" ";
            cout<<endl;
        }
        */


        int max1=0;
        for(int i=0;i<n;i++)
        {
            int coutn1=0,count2=0,count3=0;
            for(int j=0;j<n;j++)
            {
                //if(i!=j)
                {
                    if(
                        (((a[i][0]==a[j][0] && a[i][1]==a[j][1])|| (a[i][0]==a[j][2] && a[i][1]==a[j][3]) || (a[i][0]==a[j][4] && a[i][1]==a[j][5]))
                        && ((a[i][2]==a[j][0] && a[i][3]==a[j][1])|| (a[i][2]==a[j][2] && a[i][3]==a[j][3]) || (a[i][2]==a[j][4] && a[i][3]==a[j][5])
                        ))
                        ||
                        (((a[i][1]==a[j][0] && a[i][0]==a[j][1])|| (a[i][1]==a[j][2] && a[i][0]==a[j][3]) || (a[i][1]==a[j][4] && a[i][0]==a[j][5]))
                        && ((a[i][2]==a[j][0] && a[i][3]==a[j][1])|| (a[i][2]==a[j][2] && a[i][3]==a[j][3]) || (a[i][2]==a[j][4] && a[i][3]==a[j][5])
                        ))
                        ||
                        (((a[i][1]==a[j][0] && a[i][0]==a[j][1])|| (a[i][1]==a[j][2] && a[i][0]==a[j][3]) || (a[i][1]==a[j][4] && a[i][0]==a[j][5]))
                        && ((a[i][3]==a[j][0] && a[i][2]==a[j][1])|| (a[i][3]==a[j][2] && a[i][2]==a[j][3]) || (a[i][3]==a[j][4] && a[i][2]==a[j][5])
                        ))
                        ||
                        (((a[i][0]==a[j][0] && a[i][1]==a[j][1])|| (a[i][0]==a[j][2] && a[i][1]==a[j][3]) || (a[i][0]==a[j][4] && a[i][1]==a[j][5]))
                        && ((a[i][3]==a[j][0] && a[i][2]==a[j][1])|| (a[i][3]==a[j][2] && a[i][2]==a[j][3]) || (a[i][3]==a[j][4] && a[i][2]==a[j][5])
                        ))
                        )
                    {
                        coutn1++;
                    }
                    if(
                        (((a[i][0]==a[j][0] && a[i][1]==a[j][1])|| (a[i][0]==a[j][2] && a[i][1]==a[j][3]) || (a[i][0]==a[j][4] && a[i][1]==a[j][5]))
                        && ((a[i][4]==a[j][0] && a[i][5]==a[j][1])|| (a[i][4]==a[j][2] && a[i][5]==a[j][3]) || (a[i][4]==a[j][4] && a[i][5]==a[j][5])
                        ))
                        ||
                        (((a[i][1]==a[j][0] && a[i][0]==a[j][1])|| (a[i][1]==a[j][2] && a[i][0]==a[j][3]) || (a[i][1]==a[j][4] && a[i][0]==a[j][5]))
                        && ((a[i][4]==a[j][0] && a[i][5]==a[j][1])|| (a[i][4]==a[j][2] && a[i][5]==a[j][3]) || (a[i][4]==a[j][4] && a[i][5]==a[j][5])
                        ))
                        ||
                        (((a[i][0]==a[j][0] && a[i][1]==a[j][1])|| (a[i][0]==a[j][2] && a[i][1]==a[j][3]) || (a[i][0]==a[j][4] && a[i][1]==a[j][5]))
                        && ((a[i][5]==a[j][0] && a[i][4]==a[j][1])|| (a[i][5]==a[j][2] && a[i][4]==a[j][3]) || (a[i][5]==a[j][4] && a[i][4]==a[j][5])
                        ))
                        ||
                        (((a[i][1]==a[j][0] && a[i][0]==a[j][1])|| (a[i][1]==a[j][2] && a[i][0]==a[j][3]) || (a[i][1]==a[j][4] && a[i][0]==a[j][5]))
                        && ((a[i][5]==a[j][0] && a[i][4]==a[j][1])|| (a[i][5]==a[j][2] && a[i][4]==a[j][3]) || (a[i][5]==a[j][4] && a[i][4]==a[j][5])
                        ))
                        )
                    {
                        count2++;
                    }
                    if(
                        ((
                        (a[i][2]==a[j][0] && a[i][3]==a[j][1])|| (a[i][2]==a[j][2] && a[i][3]==a[j][3]) || (a[i][2]==a[j][4] && a[i][3]==a[j][5]))
                        && ((a[i][4]==a[j][0] && a[i][5]==a[j][1])|| (a[i][4]==a[j][2] && a[i][5]==a[j][3]) || (a[i][4]==a[j][4] && a[i][5]==a[j][5])
                        ))
                        ||
                        (((a[i][3]==a[j][0] && a[i][2]==a[j][1])|| (a[i][3]==a[j][2] && a[i][2]==a[j][3]) || (a[i][3]==a[j][4] && a[i][2]==a[j][5]))
                        && ((a[i][4]==a[j][0] && a[i][5]==a[j][1])|| (a[i][4]==a[j][2] && a[i][5]==a[j][3]) || (a[i][4]==a[j][4] && a[i][5]==a[j][5])
                        ))
                        ||
                        (((a[i][2]==a[j][0] && a[i][3]==a[j][1])|| (a[i][2]==a[j][2] && a[i][3]==a[j][3]) || (a[i][2]==a[j][4] && a[i][3]==a[j][5]))
                        && ((a[i][5]==a[j][0] && a[i][4]==a[j][1])|| (a[i][5]==a[j][2] && a[i][4]==a[j][3]) || (a[i][5]==a[j][4] && a[i][4]==a[j][5])
                        ))
                        ||
                        (((a[i][3]==a[j][0] && a[i][2]==a[j][1])|| (a[i][3]==a[j][2] && a[i][2]==a[j][3]) || (a[i][3]==a[j][4] && a[i][2]==a[j][5]))
                        && ((a[i][5]==a[j][0] && a[i][4]==a[j][1])|| (a[i][5]==a[j][2] && a[i][4]==a[j][3]) || (a[i][5]==a[j][4] && a[i][4]==a[j][5])
                        ))
                        )
                    {
                        count3++;
                    }

                }
            }
            max1=amx(amx(coutn1,count2),(max1,count3));
        }
        cout<<max1;


    return 0;
    }

Edited by author 03.10.2012 09:29

Who has AC, please write what answer gives out your code on the test:

2
ABCGRS
ACBGYV

У кого код получил Accepted в этой задаче, напишите пожалуйста что выдает Ваш код на тест:
2
ABCGRS
ACBGYV



Edited by author 22.03.2011 16:39

I know AC solutions that for two or more of the following tests answer 1 (but different solutions answer 1 for different tests).

In all following tests there are two bricks differing in only one side. Answer for all tests is 2. It is very important that all 6 tests should be included in the test set because different wrong solutions may make different mistakes. Wrong solutions answer 1 instead of 2 for several of these tests.

2
ABCGRS
ABCGRV

2
ABCGRS
ABCGVS

2
ABCGRS
ABCVRS

2
ABCGRS
ABVGRS

2
ABCGRS
AVCGRS

2
ABCGRS
VBCGRS

I used dynamic programming for solving this problem, on the sample test program's output is correct, I have WA1 and do not know, were is the bug. Help me, please!

import java.io.BufferedReader;
import java.io.InputStreamReader;
import java.io.PrintWriter;
import java.util.StringTokenizer;

public class Solution implements Runnable {

    BufferedReader in;
    PrintWriter out;
    StringTokenizer strtok;

    int nextInt() throws Exception {
        while (strtok == null || !strtok.hasMoreTokens()) {
            strtok = new StringTokenizer(in.readLine());
        }
        return Integer.parseInt(strtok.nextToken());
    }

    int n;
    int[][] d;
    String[] c;
    int[][] pos = {{0, 1, 3, 2, 4, 5}, // stay on bottom
                  {0, 4, 3, 5, 1, 2},  // stay on left
                  {5, 1, 4, 2, 3, 0}};

    boolean match(int c1, int pos1, int c2, int pos2) {
        char[] s1 = new char[6], s2 = new char[6];
        for (int i = 0; i < 6; ++i) {
            s1[i] = c[c1].charAt(pos[pos1][i]);
            s2[i] = c[c2].charAt(pos[pos2][i]);
        }

        boolean ok1, ok2;
        for (int shift = 0; shift < 4; ++shift) {
            ok1 = true;
            ok2 = true;
            for (int i = 0; i < 4; ++i) {
                if (s1[i] != s2[(i + shift) % 4]) {
                    ok1 = false;
                    break;
                }
            }
            for (int i = 0; i < 4; ++i) {
                if (s1[3 - i] != s2[(i + shift) % 4]) {
                    ok2 = false;
                    break;
                }
            }
            if (ok1 || ok2) {
                return true;
            }
        }
        return false;
    }

    void solve() {
        d = new int[pos.length][n];
        for (int curbox = 0; curbox < n; ++curbox) {
            for (int curpos = 0; curpos < pos.length; ++curpos) {
                d[curpos][curbox] = 1;
                for (int prevbox = 0; prevbox < curbox; ++prevbox) {
                    for (int prevpos = 0; prevpos < pos.length; ++prevpos) {
                        if (match(prevbox, prevpos, curbox, curpos)) {
                            d[curpos][curbox] = Math.max(d[curpos][curbox], d[prevpos][prevbox] + 1);
                        }
                    }
                }
            }
        }
    }

    void outputDP() {
        for (int i = 0; i < pos.length; ++i) {
            for (int j = 0; j < n; ++j) {
                out.printf("%d ", d[i][j]);
            }
            out.println();
        }
    }

    public void run() {
        try {
            in = new BufferedReader(new InputStreamReader(System.in));
            out = new PrintWriter(System.out);

            n = nextInt();
            c = new String[n];
            for (int i = 0; i < n; ++i) {
                c[i] = in.readLine();
            }
            solve();
            //outputDP();

            int max = 0;
            for (int i = 0; i < pos.length; ++i) {
                max = Math.max(d[i][n - 1], max);
            }
            out.println(max);

            /*c = new String[2];
            c[0] = in.readLine();
            int aa = nextInt();
            c[1] = in.readLine();
            int bb = nextInt();
            out.println(match(0, aa, 1, bb));*/

        } catch (Exception er) {
            er.printStackTrace();
            System.exit(13);
        } finally {
            out.close();
        }
    }

    public static void main(String[] args) {
        new Thread(new Solution()).start();
    }
}

http://acm.timus.ru/status.aspx?space=1&pos=883599

Edited by author 26.07.2005 02:30

Actually, I can figure out how to get a tower with height 3, because
there is White side in two of the bricks, but in the other two there
isn't! No matter how you rotate them you can't make a tower higher
than 1!
I would be very grateful if someone explain my.

var index:byte;
    s:array[1..1000] of string[6];
    i,j:integer;
    k,kil:integer;
    a:array[1..10] of integer;
procedure read_dat;
begin
  readln(k);
  for i:=1 to k do
    readln(s[i]);
for j:=1 to k do
  for i:=1 to 6 do
  begin
    if s[j][i]='A' then
     index:=1;
    if s[j][i]='B' then
      index:=2;
    if s[j][i]='C' then
      index:=3;
    if s[j][i]='G' then
      index:=4;
    if s[j][i]='O' then
      index:=5;
    if s[j][i]='R' then
      index:=6;
    if s[j][i]='S' then
      index:=7;
    if s[j][i]='V' then
      index:=8;
    if s[j][i]='W' then
      index:=9;
    if s[j][i]='Y' then
      index:=10;
    inc(a[index]);
  end;
end;
procedure sort(l,r:integer);
var i,j,x,y:integer;
begin
  i:=l;
  j:=r;
  x:=a[(l+r) div 2];
  repeat
    while a[i]<x do inc(i);
    while a[j]>x do dec(j);
    if i<=j then
    begin
      y:=a[i];
      a[i]:=a[j];
      a[j]:=y;
      inc(i);
      dec(j);
    end;
  until i>j ;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;
procedure solve;
begin
  writeln(a[7]);
end;
begin
  read_dat;
  sort(1,10);
  solve;
end.

I have some problem with a type of numbers and get a WA,
But now i got AC

----------------PROGRAM---------------
const col:array[1..10]of char =
('A','B','C','G','O','R','S','V','W','Y');
var
    a:array[1..10,1..10,1..10,1..10]of integer;
    hash1:array[0..255]of integer;
    N,k,max,i,k1,k2,k3,k4:integer;
    f,r,l,re,t,b:char;
    s,rrr:string;

procedure addnew;
var min:char;
    i,l:integer;
begin
  rrr[0]:=#4;
  min:=#255;
  for i:=1 to 4 do if s[i]<min then
  begin
    min:=s[i];
    l:=i;
  end;
  for i:=l to 4 do rrr[i-l+1]:=s[i];
  for i:=1 to l-1 do rrr[i+4-l+1]:=s[i];
  inc(a[ord(rrr[1]),ord(rrr[2]),ord(rrr[3]),ord(rrr[4])]);
end;

begin
  for i:=1 to 10 do hash1[ord(col[i])]:=i;
{  assign(input,'1127.dat');reset(input);}
  readln(N);
  for k:=1 to N do
  begin
    readln(s);
    for i:=1 to 6 do
     s[i]:=chr(hash1[ord(s[i])]);
    f:=s[1];r:=s[2];l:=s[3];re:=s[4];t:=s[5];b:=s[6];
    s[0]:=#4;
    s[1]:=f;s[2]:=l;s[3]:=re;s[4]:=r;
    addnew;
    s[1]:=t;s[2]:=re;s[3]:=b;s[4]:=f;
    addnew;
    s[1]:=t;s[2]:=r;s[3]:=b;s[4]:=l;
    addnew;
  end;
  max:=0;
  for k1:=1 to 10 do for k2:=1 to 10 do for k3:=1 to 10 do for k4:=1
to 10 do
  if a[k1,k2,k3,k4]>max then max:=a[k1,k2,k3,k4];
  writeln(max);
end.

program  cubic;

type  Tr=record
        b,
        e:Longint;
        u:boolean;
      end;


var  cubics:array [0..1000,0..3] of string[7];
     n,i,j,k,result:integer;


procedure setfirst(var str:string);
var odd,i,num:byte;
    tmp,tmp2:string;
    c:char;
begin
num:=1;
odd:=90;
tmp:='';
tmp2:='';
for i:=1 to 4 do
    begin
    if ord(str[num])>ord(str[i]) then num:=i;
    end;

for i:=1 to (num-1) do
    begin
    tmp:=tmp+str[i];
    end;

for i:=num to 4 do
    begin
    tmp2:=tmp2+str[i];
    end;

str:='';
str:=tmp2+tmp;

if ord(str[2])>ord(str[4]) then
   begin
   c:=str[2];
   str[2]:=str[4];
   str[4]:=c;
   end;

end;



procedure ReadData;
var str:string;
begin
    readln(n);
    for i:=1 to n do
    begin
         readln(cubics[i,0]);
         cubics[i,1]:=cubics[i,1]+cubics[i,0,1];
         cubics[i,1]:=cubics[i,1]+cubics[i,0,2];
         cubics[i,1]:=cubics[i,1]+cubics[i,0,4];
         cubics[i,1]:=cubics[i,1]+cubics[i,0,3];
         str:=cubics[i,1];
         setfirst(str);
         cubics[i,1]:=str;

         cubics[i,2]:=cubics[i,2]+cubics[i,0,2];
         cubics[i,2]:=cubics[i,2]+cubics[i,0,5];
         cubics[i,2]:=cubics[i,2]+cubics[i,0,3];
         cubics[i,2]:=cubics[i,2]+cubics[i,0,6];
         str:=cubics[i,2];
         setfirst(str);
         cubics[i,2]:=str;

         cubics[i,3]:=cubics[i,3]+cubics[i,0,1];
         cubics[i,3]:=cubics[i,3]+cubics[i,0,5];
         cubics[i,3]:=cubics[i,3]+cubics[i,0,4];
         cubics[i,3]:=cubics[i,3]+cubics[i,0,6];
         str:=cubics[i,3];
         setfirst(str);
         cubics[i,3]:=str;

    end;

end;

procedure WriteData;
var str:string;
begin
    for i:=1 to n do
    begin
         for j:=1 to 3 do

             writeln(cubics[i,j]);
         writeln;

    end;
writeln(result);
end;



procedure RUN;
var str:string;
var k,l,k1,temp:integer;
begin


result:=1;
temp:=1;
for i:=1 to n do
begin
     for j:=1 to 3 do
     begin
          str:=cubics[i,j];
          for k:=1 to (n-1) do
          begin
          k1:=k1+1;
          if k1=i then k1:=k1+1;
               for l:=1 to 3 do
               begin
                    if str=cubics[k1,l] then
                    begin
                    temp:=temp+1;

                    end;

               end;

          end;

     if temp>result then
     result:=temp;
     temp:=1;

     end;

end;
end;


begin
    init;
    readdata;
    run;
    writedata;
end.

I got WA, but I think my program is correct.

My program:

Program t1127;

Const P:array[1..24,1..6]of integer= {all combinations}
       ( (6,4,3,1,5,2),
         (3,5,4,1,6,2),
         (4,6,5,1,3,2),
         (5,3,6,1,4,2),
         (6,4,5,2,3,1),
         (3,5,6,2,4,1),
         (4,6,3,2,5,1),
         (5,3,4,2,6,1),
         (1,2,6,3,4,5),
         (6,4,2,3,1,5),
         (2,1,4,3,6,5),
         (4,6,1,3,2,5),
         (1,2,4,5,6,3),
         (6,4,1,5,2,3),
         (2,1,6,5,4,3),
         (4,6,2,5,1,3),
         (1,2,3,4,5,6),
         (3,5,2,4,1,6),
         (2,1,5,4,3,6),
         (5,3,1,4,2,6),
         (1,2,5,6,3,4),
         (3,5,1,6,2,4),
         (2,1,3,6,5,4),
         (5,3,2,6,1,4)  );
   MaxN=1000;

Var Cube      :array[1..MaxN,1..6]of char;
    Tmp       :array[1..6]of char;
    ACube     :array[1..MaxN,1..24]of string[4];
    yet       :array[1..MaxN,1..24]of boolean;
    N,i,j,k   :integer;
    max,ik,jk :integer;
    m         :integer;
    ch        :char;

begin
Read(n);
for i:=1 to N do
 for j:=1 to 6 do begin
  read(ch);
  while (ch=#10)or(ch=#13)or(ch=#32) do read(ch);
  Cube[i,j]:=ch;
 end;
for i:=1 to N do
 for j:=1 to 24 do begin
  for k:=1 to 6 do tmp[k]:=cube[i,p[j,k]];
  ACube[i,j]:='';
  ACube[i,j]:=tmp[1]+tmp[2]+tmp[3]+tmp[4];
 end;
m:=0;
for i:=1 to N do
 for j:=1 to 24 do
  yet[i,j]:=true;
for i:=1 to N do
 for j:=1 to 24 do if yet[i,j] then begin
  yet[i,j]:=false;
  max:=1;
  for ik:=1 to N do if ik<>i then
   for jk:=1 to 24 do
    if ((acube[i,j][1]=acube[ik,jk][1])and(acube[i,j][4]=acube[ik,jk]
[4]))or
       ((acube[i,j][1]=acube[ik,jk][4])and(acube[i,j][4]=acube[ik,jk]
[1])) then
    if ((acube[i,j][2]=acube[ik,jk][2])and(acube[i,j][3]=acube[ik,jk]
[3]))or
       ((acube[i,j][2]=acube[ik,jk][3])and(acube[i,j][3]=acube[ik,jk]
[2]))
       then begin
     yet[ik,jk]:=false;
     max:=max+1;
     break;
    end;
  if max>m then m:=max;
 end;
writeln(m);
end.

My program:

Program t1127;

Const P:array[1..24,1..6]of integer= {all combinations}
       ( (6,4,3,1,5,2),
         (3,5,4,1,6,2),
         (4,6,5,1,3,2),
         (5,3,6,1,4,2),
         (6,4,5,2,3,1),
         (3,5,6,2,4,1),
         (4,6,3,2,5,1),
         (5,3,4,2,6,1),
         (1,2,6,3,4,5),
         (6,4,2,3,1,5),
         (2,1,4,3,6,5),
         (4,6,1,3,2,5),
         (1,2,4,5,6,3),
         (6,4,1,5,2,3),
         (2,1,6,5,4,3),
         (4,6,2,5,1,3),
         (1,2,3,4,5,6),
         (3,5,2,4,1,6),
         (2,1,5,4,3,6),
         (5,3,1,4,2,6),
         (1,2,5,6,3,4),
         (3,5,1,6,2,4),
         (2,1,3,6,5,4),
         (5,3,2,6,1,4)  );
   MaxN=1000;

Var Cube      :array[1..MaxN,1..6]of char;
    Tmp       :array[1..6]of char;
    ACube     :array[1..MaxN,1..24]of string[4];
    yet       :array[1..MaxN,1..24]of boolean;
    N,i,j,k   :integer;
    max,ik,jk :integer;
    m         :integer;
    ch        :char;

begin
Read(n);
for i:=1 to N do
 for j:=1 to 6 do begin
  read(ch);
  while (ch=#10)or(ch=#13)or(ch=#32) do read(ch);
  Cube[i,j]:=ch;
 end;
for i:=1 to N do
 for j:=1 to 24 do begin
  for k:=1 to 6 do tmp[k]:=cube[i,p[j,k]];
  ACube[i,j]:='';
  ACube[i,j]:=tmp[1]+tmp[2]+tmp[3]+tmp[4];
 end;
m:=0;
for i:=1 to N do
 for j:=1 to 24 do
  yet[i,j]:=true;
for i:=1 to N do
 for j:=1 to 24 do if yet[i,j] then begin
  yet[i,j]:=false;
  max:=1;
  for ik:=1 to N do if ik<>i then
   for jk:=1 to 24 do
    if ((acube[i,j][1]=acube[ik,jk][1])and(acube[i,j][4]=acube[ik,jk]
[4]))or
       ((acube[i,j][1]=acube[ik,jk][4])and(acube[i,j][4]=acube[ik,jk]
[1])) then
    if ((acube[i,j][2]=acube[ik,jk][2])and(acube[i,j][3]=acube[ik,jk]
[3]))or
       ((acube[i,j][2]=acube[ik,jk][3])and(acube[i,j][3]=acube[ik,jk]
[2]))
       then begin
     yet[ik,jk]:=false;
     max:=max+1;
     break;
    end;
  if max>m then m:=max;
 end;
writeln(m);
end.

My program:

Program t1127;

Const P:array[1..24,1..6]of integer= {all combinations}
       ( (6,4,3,1,5,2),
         (3,5,4,1,6,2),
         (4,6,5,1,3,2),
         (5,3,6,1,4,2),
         (6,4,5,2,3,1),
         (3,5,6,2,4,1),
         (4,6,3,2,5,1),
         (5,3,4,2,6,1),
         (1,2,6,3,4,5),
         (6,4,2,3,1,5),
         (2,1,4,3,6,5),
         (4,6,1,3,2,5),
         (1,2,4,5,6,3),
         (6,4,1,5,2,3),
         (2,1,6,5,4,3),
         (4,6,2,5,1,3),
         (1,2,3,4,5,6),
         (3,5,2,4,1,6),
         (2,1,5,4,3,6),
         (5,3,1,4,2,6),
         (1,2,5,6,3,4),
         (3,5,1,6,2,4),
         (2,1,3,6,5,4),
         (5,3,2,6,1,4)  );
   MaxN=1000;

Var Cube      :array[1..MaxN,1..6]of char;
    Tmp       :array[1..6]of char;
    ACube     :array[1..MaxN,1..24]of string[4];
    yet       :array[1..MaxN,1..24]of boolean;
    N,i,j,k   :integer;
    max,ik,jk :integer;
    m         :integer;
    ch        :char;

begin
Read(n);
for i:=1 to N do
 for j:=1 to 6 do begin
  read(ch);
  while (ch=#10)or(ch=#13)or(ch=#32) do read(ch);
  Cube[i,j]:=ch;
 end;
for i:=1 to N do
 for j:=1 to 24 do begin
  for k:=1 to 6 do tmp[k]:=cube[i,p[j,k]];
  ACube[i,j]:='';
  ACube[i,j]:=tmp[1]+tmp[2]+tmp[3]+tmp[4];
 end;
m:=0;
for i:=1 to N do
 for j:=1 to 24 do
  yet[i,j]:=true;
for i:=1 to N do
 for j:=1 to 24 do if yet[i,j] then begin
  yet[i,j]:=false;
  max:=1;
  for ik:=1 to N do if ik<>i then
   for jk:=1 to 24 do
    if ((acube[i,j][1]=acube[ik,jk][1])and(acube[i,j][4]=acube[ik,jk]
[4]))or
       ((acube[i,j][1]=acube[ik,jk][4])and(acube[i,j][4]=acube[ik,jk]
[1])) then
    if ((acube[i,j][2]=acube[ik,jk][2])and(acube[i,j][3]=acube[ik,jk]
[3]))or
       ((acube[i,j][2]=acube[ik,jk][3])and(acube[i,j][3]=acube[ik,jk]
[2]))
       then begin
     yet[ik,jk]:=false;
     max:=max+1;
     break;
    end;
  if max>m then m:=max;
 end;
writeln(m);
end.