Найдите среди трех очередей две одинаковые - Free Pascal

Формулировка задачи:

Посмотрите что у меня получилось!)спасибо)

program och;
uses crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next:List;
  end;
procedure AddElem(var stek1:List;znach1:TInf);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList));
  tmp^.next:=stek1;
 
  tmp^.data:=znach1;
  stek1:=tmp;
end;
 function equal(s1,s2,s3:List):boolean;
 begin
 if (s1=nil) or(s2=nil)or(s3=nil) then begin
 equal:=(s1=s2=s3) else
 begin
 while(s1^.next<>nil)and(s2^.next<>nil)and(s3^.next<>nil)and(s1^data=s2^data=s3^data)
 do begin
 s1:=s1^next;s2:=s2^next; s3:=s3^next; end;
 if(s1^next=s2^next)and(s1^data=s2^data ) then
 begin
 writeln('ravny 1 i 2 ochered');
 
 if(s2^next=s3^next)and(s2^data=s3^data ) then
  writeln('ravny 3 i 2 ochered');
 if(s1^next=s3^next)and(s1^data=s3^data ) then
  writeln('ravny 1 i 3 ochered');
end;
 var
 s1:list=nil;
 s1:list=nil ;
 s1:list=nil ;
 
 a,n,n2,n3:longint;

BEGIN
clrscr;
writeln('vvedite kol elementoff v 1 ocheredi');readln(n);
writeln('vvedite kol elementoff v 2 ocheredi');readln(n2);
writeln('vvedite kol elementoff v 3 ocheredi');readln(n3);
for a:=1 to n do
begin
write('s1[a]=');
readln(s1[a]);
end;
for a:=1 to n2 do
begin
write('s2[a]=');
readln(s2[a]);
end;
for a:=1 to n3 do
begin
write('s3[a]=');
readln(s3[a]);
end;
equal(s1,s2,s3);
 
END.

Решение задачи: «Найдите среди трех очередей две одинаковые»

Листинг программы

program och;
uses crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next:List;
  end;
 
procedure AddElem(var q:List; znach1:TInf);
var
  p, new_item:List;
begin
  new(new_item);
  new_item^.data := znach1;
  new_item^.next := nil;
  if q = nil then q := new_item
  else
  begin
    p := q;
    while p^.next <> nil do p := p^.next;
    p^.next := new_item;
  end;
end;
 
function equals(p, q : list) : boolean;
begin
  if p = q then equals := true
  else if (p = nil) or (q = nil) then equals := false
  else equals := (p^.data = q^.data) and equals(p^.next, q^.next);
end;
 
function equal(s1,s2,s3:List):boolean;
begin
  if equals(s1, s2) then writeln('s1 = s2')
  else if equals(s1, s3) then writeln('s1 = s3')
  else if equals(s2, s3) then writeln('s2 = s3')
  else writeln('none equals');
end;
 
procedure enter(number : integer; var s : List);
var
  n, i : integer;
  item : integer;
begin
  writeln('vvedite kol elementoff v ', number, ' ocheredi'); readln(n);
  for i := 1 to n do
  begin
    write('-> '); readln(item);
    AddElem(s, item);
  end;
 
end;
 
var
 s1:list=nil;
 s2:list=nil;
 s3:list=nil;
 
BEGIN
  clrscr;
  enter(1, s1);
  enter(2, s2);
  enter(3, s3);
  equal(s1,s2,s3);
END.

Объяснение кода листинга программы

Объявлены типы данных: Tinf - целочисленный тип, List - указатель на запись, TList - запись, содержащая целочисленное значение и указатель на следующую запись в списке.
Создана процедура AddElem, которая добавляет новый элемент в список. Если список пуст, то создается новый элемент и он становится первым в списке. Если список не пуст, то ищется последний элемент списка, и новый элемент добавляется после него.
Создана функция equals, которая проверяет, равны ли два списка. Если один из списков пуст, то функция возвращает false. Если списки содержат одинаковые значения, то функция рекурсивно вызывает себя для проверки следующих элементов списка.
Создана функция equal, которая проверяет, равны ли три списка. Если какой-то из списков равен двум другим, то выводится соответствующее сообщение.
Создана процедура enter, которая запрашивает у пользователя количество вводимых элементов и сами элементы для каждого из трех списков.
В основной части программы создаются три пустых списка s1, s2, s3.
Программа запрашивает у пользователя ввод трех групп элементов, каждая группа состоит из введенного количества элементов.
Затем вызывается функция equal для проверки равенства трех списков.
Если какой-то из списков не равен двум другим, то выводится соответствующее сообщение.