[Tin 11] Quay Rubic

[thanhkhoeo]

[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

Rubic là một khối lập phương gồm 3´3´3 = 27 khối lập phương con. Mỗi mặt rubic gồm 3´3 = 9 mặt của một lớp 9 khối lập phương con. ở trạng thái ban đầu, mỗi mặt rubic được tô một màu. Các mặt khác nhau được tô các màu khác nhau. Giả sử ta đang nhìn vào một mặt trước của rubic. Có thể kí hiệu màu các mặt như sau: F: màu mặt trước là mặt ta đang nhìn; U: màu mặt trên; R: màu mặt phải; B: màu mặt sau; L: màu mặt bên trái; D: màu mặt dưới.
Một lớp gồm 3´3 khối lập phương con có thể quay 90 độ nhiều lần, trục quay đi qua tâm và vuông góc với mặt đang xét. Kết quả sau khi quay là khối lập phương 3´3´3 với các màu mặt đã bị đổi khác.
Một xâu vòng quay liên tiếp rubic có thể mô tả bằng xâu các chữ cái của U, R, F, D, B, L, trong đó mỗi chữ cái là kí hiệu một vòng quay cơ sở: quay mặt tương ứng 90 độ theo chiều kim đồng hồ. Hãy viết chương trình giải 3 bài toán dưới đây:
1. Cho 2 xâu INPUT khác nhau, kiểm tra xem liệu nếu áp dụng với trạng thái đầu có cho cùng một kết quả hay không?
2. Cho một xâu vào, hãy xác định số lần cần áp dụng xâu vào đó cho trạng thái đầu rubic để lại nhận được trạng thái đầu đó.




Các mod đâu rồi làm hộ tớ cái >>>>

 

[kieuquocdat]

Đây là bài em tham khảo(không phải tự làm)
Program Rubic;
uses Crt;
Type Arr= array[0..5, 0..7] of byte;
const color: Array [0..5] of char=('F', 'U','R', 'B', 'L', 'D');
Var
A1, A2, A0, A: Arr;
X, X1, X2: String;
k: byte;
Procedure Nhap;
Var i, j: byte;
Begin
Clrscr;
Writeln ('Bai toan 1. So sanh hai xau:');
Writeln ('Nhap xau X1:');
Readln (X1);
Writeln (' Nhap xau X2:');
Readln (X2);
Writeln ('Bai toan 2. Tinh so lan xoay:');
Write ('Nhap xau X:');
Readln (X);
For i:= 0 to 5 do
For j:= 0 to 7 do A[i, j]:= i;
A:=A0; A1:=A0; A2:=A0;
End;
Procedure Quay (Var A: Arr; k: byte);
Const Dir : array
[0.. 5, 0.. 3, 0.. 3] of byte = ( ( (1,2,5,4), (6,0,2,4), (5,7,1,3), (4,6,0,2) ),
( (0,4,3,2), (0,0,4,0), (1,1,5,1), (2,2,6,2) ),
( (0,1,3,5), (4,4,4,4), (3,3,3,3), (2,2,2,2) ),
( (1,4,5,2), (2,0,6,4), (1,7,5,3), (0,6,4,2) ),
( (0,5,3,1), (0,0,0,0), (7,7,7,7),(6,6,6,6) ),
( (0,2,3,4), (6,6,2,6), (5,5,1,5), (4,4,0,4) ) );
var i,j,tg: byte;
Begin
tg:=A[k,6];
for i:=3 downto 1 do A[k,0] := A[k,2*i-2];
A[k,0]:=tg;
tg:=A[k,7];
for i:=3 downto 1 do A[k,2*i] := A[k,2*i -2];
A[k,1]:=tg;
for i:=1 to 3 do
begin
tg:=A[dir[k,0,3], Dir[k,i,3];
for j:=3 downto 1 do A[ dir[k,0,j], Dir[k,i,j] ]:= A[ dir[k,0,j-1], Dir[k,i,j-1] ];
A[ [dir[k,0,0], Dir[k,i,0] ]:=tg;
end;
End;
Function Eq(A,B:Arr):Boolean;
Var i,j,c:byte;
Begin
c:=0;
for i:=1 to 5 do
for j:=1 to 7 do
If A[i,j] <> B[i,j] then inc(c);
If c=0 then Eq:=true else Eq:=false;
End;
Procedure QuayXau(x:string; var A: arr);
Var i,j:byte;
Begin
for i:=1 to length(X) do
begin
for j:= 1 to 5 do
If Color[j] = X then Quay(A,j);
end;
End;
Procedure Bai1;
Begin
QuayXau(X1,A1);
QuayXau(X2,A2);
End;
Procedure Bai2;
Begin
k:=0;
Repeat
QuayXau(X,A);
Inc(k);
Until Eq(A,A0);
End;
Procedure Xuat;
Var i,j:byte;
Begin
writeln;
writeln('Ket qua:');
writeln('Bai toan 1. So sanh 2 xau:') ;
If Eq(A1,A2) then writeln('Hai xau X1 va X2 cho cung mot ket qua.');
writeln('Can ap dung xau X ',k,' lan de Rubic quay ve trang thai ban dau.');
Readln;
End;
Begin
Nhap;
Bai1;
Bai2;
Xuat;
END.