Pascal abc: Вводится массив 4*6. Найти две строки, в которых элементы одинаковы но могут стоять в разной последовательности.

[GreenCode]

Вводится массив 4*6. Найти две строки, в которых элементы одинаковы но могут стоять в разной последовательности.
Используя основы языка.

[digitalis]

Новый год продолжается, и форумцы в спячке Чтоб выйти из запоя, решил накропать для разминки пальцев и бошки. На Паскале лень, потому на Дельфи. Тем более, что спросившему это уже до фонаря, а если нет - сам перепрет в Паскаль

Изящное решение не получается, потому тупо. Можно, конечно, вспомогательный массив, в который отсортированные строчки исходного, но ну его.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Math, ExtCtrls;

type

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);

  private
    { Private declarations }
  public

  end ;
const a24 : array [1..24] of integer =
    ( 1,2,3,4,5,6,9,9,9,9,9,9,6,1,5,2,4,3,0,0,0,0,0,7 ) ;
var
  Form1: TForm1  ;
  ar : array[1..4,1..6] of integer ; n6 : integer ;
implementation

{$R *.dfm}


procedure TForm1.FormClick(Sender: TObject);

  var i,j : integer ; stro : string ;

  function cmpstr (n1,n2 : integer) : boolean ;
  var k,k1 : integer ; tmp : array [1..6] of boolean ;
  begin
     for k := 1 to 6 do tmp[k] := True ; n6 := 0 ;
     for k := 1 to 6 do
       for k1 := 1 to 6 do
         if (ar[n1,k]=ar[n2,k1]) and tmp[k1] then
            begin  Inc (n6) ; tmp[k1] := False ; Break end ;
     if n6=6 then Result := True else Result := False ;
   end ;
//=======================
begin
   for i := 1 to 3 do
     for j := i+1 to 4 do
       begin
         if cmpstr(i,j) then stro := ' + ' else stro := '   ' ;
         stro := stro + Format(' n6=%2d %2d %2d',[n6,i,j]) ;
         Memo1.Lines.Add(stro)
       end ;  
end ;

procedure TForm1.FormActivate(Sender: TObject);
// Это  просто  заполнение массива  тестовым
// набором данных.
var i,j,k : integer ; stro: string ;
begin
  k := 1 ;
  for i := 1 to 4 do
    for j := 1 to 6 do
       begin ar[i,j] := a24[k] ; Inc (k) end ;
  for i := 1 to 4 do
    begin
      stro := '' ;
      for j := 1 to 6 do
        stro := stro + Format(' %2d',[ar[i,j]]) ;
      Memo1.Lines.Add(stro)
    end ;
end ;

end.

[GreenCode]

Спасибо, но в делфи совсем не шарю. Пока ждал свой код подредактировал но не работает и не могу понять почему, помогите найти ошибку

program ab111;
type aa1=array[1..3,1..3] of integer;

bb1=set of integer;

var
a1:aa1;
b1,b2,b3:bb1;

x,y,i,j,n:integer;
begin
b1:=[];
b2:=[];
b3:=[];
for i:=1 to 3 do 
for j:=1 to 3 do 
begin 
readln (a1[i,j]);
end;

repeat;
for j:=1 to 3 do
begin
for i:=1 to 3 do
begin
b1:=b1+[a1[i,j]];
end;
for y:=1 to 3 do
begin
b2:=b1;
for x:=1 to 3 do
begin
if a1[x,y] in b2 then
b2:=b2-[a1[x,y]];
end;
if (b2=b3)=true then
begin
n:=n+1;
b2:=b1;
end
else
begin
b2:=b1;
end;
end;
end;
until (n>1)=true;


write(b1);
end.

[Aleksandr H.]

Сообщение от digitalis

Новый год продолжается, и форумцы в спячке

Че там за алго? Сортануть строки по возростанию и сравнить их?

[GreenCode]

Сообщение от Aleksandr H.

Че там за алго? Сортануть строки по возростанию и сравнить их?

Можно и так

[digitalis]

1. Посмотрев хотя бы пару тем форума, следовало бы заметить, как оформляются ( форматируются ) программы: с отступами, позволяющими выявить структуру проги и легко ее понять. У тебя же строем, как в казарме, и читать неохота.
2. Дельфи - это Object Pascal, если не касаться ввода-вывода, то на 98% совпадает с "обычныи" Плескалем, и функция cmpstr переносится туда 1:1. Напишешь сам ввод-вывод, 2 вложенных цикла

   for i := 1 to 3 do
     for j := i+1 to 4 do
       begin
         if cmpstr(i,j) then // удачно,  строки  i-тая и j-тая совпали

и вуаля - задача решена. Если и с этим будет напряг, вот накормлю котов и перепишу.
3. Конечно, можно и через сортировку, но это лишняя загрузка. У меня введен вспомогательный булев массив tmp, чтобы не рассматривать повторно уже совпавший элемент. Так короче, я думаю. Проверено. Фурчит.

Ну и в качестве мелкой придирки : в цикле один оператор - begin и end не нужен. Компилятору-то пофиг, а для чтение загромождает .

for i:=1 to 3 do
begin
b1:=b1+[a1[i,j]];
end;

[digitalis]

program  abc ;

var ar : array [1..4,1..6] of integer ; i,j,n6 : integer ;

function cmpstr (n1,n2 : integer) : boolean ;
  var k,k1 : integer ; tmp : array [1..6] of boolean ;
  begin
     for k := 1 to 6 do tmp[k] := True ;
     n6 := 0 ;
     for k := 1 to 6 do
       for k1 := 1 to 6 do
         if ( (ar[n1,k]=ar[n2,k1]) and tmp[k1] ) then
            begin  Inc (n6) ; tmp[k1] := False ; Break end ;
     if n6=6 then cmpstr := True else cmpstr := False ;
   end ;

begin

   for i := 1 to 4 do
     for j := 1 to 6 do  Read (ar[i,j]) ;
   Writeln ('---') ;
   for i := 1 to 4 do
     begin 
       for j := 1 to 6 do  Write (' ',ar[i,j]) ;
       Writeln ('  -');
     end ;

   for i := 1 to 3 do
     for j := i+1 to 4 do
         if cmpstr(i,j) then Writeln  ( 'Matching rows i=',i,' j=',j) ;
   Writeln ('---') ;
end.

Результат работы :

[digitalis]

А в ответ - тишина ...

[GreenCode]

Огромное спасибо.
К замечаниям прислушаюсь