Комментарии (3) свернуть  |  развернуть

+1
Задание 1.1
{$APPTYPE CONSOLE}
uses
  SysUtils;
var
  a,b:string;
  m: array[1..4,1..4] of char;
  i,j,c: integer;
begin
  assign(input,'input.txt');
  assign(output,'output.txt');
  readln(a);
  readln(b);
  for i:=1 to 4 do
    for j:=1 to 4 do
      m[i,j]:=b[4*(i-1)+j];
  c:=1;
  for i:=1 to 4 do
  begin
    for j:=1 to 4 do
      if (a[c+4*0]=m[i,j]) and
         (a[c+4*1]=m[j,5-i]) and
         (a[c+4*2]=m[5-i,5-j]) and
         (a[c+4*3]=m[5-j,i]) then
         begin
            write(c);
            inc(c);
         end
      else write('0');
    writeln;
  end;
  close(input);
  close(output);
end.
Задание 1.2
{$APPTYPE CONSOLE}
uses
  SysUtils;
var
  a,b:string;
  m: array[1..10,1..10] of char;
  i,j,c: integer;
  l,r,k: integer;
begin
  assign(input,'input.txt');
  assign(output,'output.txt');
  readln(a);
  readln(b);
  l:=round(sqrt(length(a)));
  r:=l+1;
  k:=length(a) div 4;
  for i:=1 to l do
    for j:=1 to l do
      m[i,j]:=b[l*(i-1)+j];
  for i:=1 to l do
   begin
    for j:=1 to l do write(m[i,j]);
    writeln;
  end;
  c:=1;
  for i:=1 to l do
  begin
    for j:=1 to l do
      if (a[c+k*0]=m[i,j]) and
         (a[c+k*1]=m[j,r-i]) and
         (a[c+k*2]=m[r-i,r-j]) and
         (a[c+k*3]=m[r-j,i]) then
         begin
            write(c);
            inc(c);
         end
      else write('0');
    writeln;
  end;
  close(input);
  close(output);
end.
+1
Моё универсальное… Вроде должно работать...)

{$APPTYPE CONSOLE}

uses
  SysUtils, Math, Types;

function StepPoint(pnt: TPoint; n, step: Integer): TPoint;
begin
  case step of
    1: result := pnt;
    2: result := Point(n - pnt.Y + 1, pnt.X);
    3: result := Point(n - pnt.X + 1, n - pnt.Y + 1);
    else result := Point(pnt.Y, n - pnt.X + 1);
  end;
end;

var
  i, j, n, l, p, s: Integer;
  etl, str, tmp: String;
  res: array of array of Integer;
  pnt: TPoint;
  f: Boolean;
begin
  AssignFile(input, 'input.txt');
  Reset(input);
  ReadLn(etl);
  ReadLn(str);
  Close(input);

  n := Ceil(Sqrt(Length(str)));
  l := n * n div 4;
  SetLength(res, n, n);
  while Length(str) < n*n do str := str + ' ';
  while Length(etl) < n*n do etl := etl + ' ';

  for j := 1 to n do
    for i := 1 to n do
      res[i-1,j-1] := 0;

  for j := 1 to n div 2 do
    for i := j to n - j do
      for s := 1 to 4 do
        begin
          f := false;
          tmp := '';
          for p := 1 to 4 do
            begin
              pnt := StepPoint(Point(i,j), n, (p + s - 1) mod 4);
              tmp := tmp + str[(pnt.Y - 1) * n + pnt.X];
            end;
          for p := 1 to l do
            if etl[p] + etl[p+l] + etl[p+2*l] + etl[p+3*l] = tmp then
              begin
                pnt := StepPoint(Point(i,j), n, s);
                res[pnt.X-1, pnt.Y-1] := p;
                f := true;
                break;
              end;
          if f then break;
        end;

  AssignFile(output, 'output.txt');
  Rewrite(output);
  for j := 1 to n do
    begin
      for i := 1 to n do
        Write(res[i-1,j-1]);
      if j < n then WriteLn;
    end;
  Close(output);
end.
0
Совсем чуть-чуть оптимизировал… И оптимизировал ли?..

Код где-то рядом...
{$APPTYPE CONSOLE}

uses
  SysUtils, Math, Types, StrUtils;

function StepPoint(pnt: TPoint; n, step: Integer): TPoint;
begin
  case step mod 4 of
    1: result := pnt;
    2: result := Point(n - pnt.Y + 1, pnt.X);
    3: result := Point(n - pnt.X + 1, n - pnt.Y + 1);
    else result := Point(pnt.Y, n - pnt.X + 1);
  end;
end;

label
  loopEnd;
var
  i, j, n, l, p: Integer;
  etl, str, tmp: String;
begin
  AssignFile(input, 'input.txt');
  Reset(input);
  ReadLn(etl);
  ReadLn(str);
  Close(input);

  n := Ceil(Sqrt(Length(str)));
  l := n * n div 4;
  str := str + DupeString(' ', n * n - length(str));
  etl := etl + DupeString(' ', n * n - length(etl));

  AssignFile(output, 'output.txt');
  Rewrite(output);

  for j := 1 to n do
    for i := 1 to n do
      begin
        tmp := '';
        for p := 1 to 4 do
          tmp := tmp + str[(StepPoint(Point(i,j), n, p).Y - 1) * n + StepPoint(Point(i,j), n, p).X];
        for p := 1 to l do
          if etl[p] + etl[p+l] + etl[p+2*l] + etl[p+3*l] = tmp then
            begin
              Write(p);
              goto loopEnd;
            end;
        Write(0);
      loopEnd:
        if (i = n) and (j < n) then WriteLn;
      end;

  Close(output);
end.

Прокомментировать