Сортировка односвязного списка

{Вариант 21.
Ввести последовательность натуральных чисел. Если последовательность упорядочена 
по неубыванию или по невозрастанию, удалить из последовательности числа, кратные 15, 
и продублировать простые числа. В противном случае упорядочить последовательность 
по невозрастанию первой цифры. Последовательность хранить в односвязном списке. 
Перед  завершением программы очистить динамическую память с помощью процедуры  
Dispose.}
 
 
program lab12;
type List=^node;
     elemtype=Integer;
     node=record
        number: elemtype;
        first: elemtype;
        next: list
        end;
var lst: List;
    count: Integer; {Количество чисел}
 
function FirstDigit(n: Integer): Integer;
var first: Integer;
begin
    while n<>0 do begin
        first:=n mod 10;
        n:=n div 10;
    end;
    FirstDigit:=first;
end;
 
 
function IsPrime(x: Integer): boolean;
var i: Integer;
begin
    isPrime:=false;
    if x<2 then Exit;
    if not odd(x) and (x<>2) { проверяем на чётность  }
    then exit;
    i:=3;
    while i <= sqrt(x) do { проверяем только нечётные }
        begin
           if x mod i = 0 then Exit;
           inc(i,2);
        end;
    isPrime:=true;
end;
 
procedure InputSeq(var head: List);
var p,q: List;
begin
    count:=0;
    while not EoLn do begin
        new(p);
        read(p^.number);
        inc(count);
        p^.first:=FirstDigit(p^.number);
        if head=nil then
            head:=p
        else q^.next:=p;
        q:=p;
    end;
    p^.next:=nil;
end;
 
procedure OutputSeq(head: List);
var p: List;
begin
    p:=head;
    while p<>nil do begin
        write(p^.number, ' ');
        p:=p^.next;
    end;
end;
 
procedure DeleteMultiples(var head: List);
var
    p, prev, copy: List;
begin
    prev := nil;
    p := head;
    while p <> nil do begin
        if (p^.number mod 15) = 0 then begin
            if prev <> nil then
                prev^.next := p^.next
            else
                head := p^.next;
            copy := p;
            p := p^.next;
            dispose(copy)
        end
        else begin
            prev := p;
            p := p^.next;
        end;
    end;
end;
 
 
 
{ Дублирует простые числа в списке начиная с el }
procedure DoublePrimes(head: List);
var p, nw: List;
begin
    p:=head;
    while p <> nil do begin
        if (IsPrime(p^.number)) then begin
            new(nw); // Создаем новый элемент,
            nw^.number := p^.number; // дублируем в него
            nw^.next := p^.next; // эл. с простым числом,
            p^.next := nw; // вставляем новый элемент.
            p := nw; // Пропускаем дубляж.
        end;
        p := p^.next;
    end;
end;
 
procedure double2(var head: List);
var p: List;
begin
    if head<>nil then begin
        if IsPrime(head^.number) then begin
            new(p);
            p^.number:=head^.number;
            p^.next:=head^.next;
            head^.next:=p;
        end;
        if IsPrime(head^.number) then
            double2(p^.next)
        else
            double2(head^.next);
    end;
end;
    
function IsSorted(el: List): Boolean;
var
    decrescent, rising: Boolean;
    next: List;
begin
    decrescent := true; rising := true; // список из 1 или 0 эл. тоже неубывающий
    while el <> nil do begin
        next := el^.next; // следующий эл. (или nil)
        if next <> nil then begin // если не последний
            if decrescent then
                decrescent := next^.number <= el^.number;
            if rising then
                rising := next^.number >= el^.number;
            if not (rising or decrescent) then // оба теста уже завалены
                break;
            el := next;
        end else
            break;
    end;
    IsSorted := decrescent or rising;
end;
 
procedure BubbleDownSort(var head: List);
var p, q: List;
    temp: Integer;
begin
    p:=head;
    while p <> nil do begin
        q:=p^.next;
        while q <> nil do begin
            if (p^.first <= q^.first) then begin
                temp:=p^.number;
                p^.number:=q^.number;
                q^.number:=temp;
            end;
            q:=q^.next;
        end;
        p:=p^.next;
    end;
end;
 
procedure sort(var head: List);
var p, q, m: List; 
    temp: Integer;
begin
    p:=head;
    while p<>nil do begin
        q:=p;
        m:=q;
        while q<>nil do begin
            if m^.first<=q^.first then 
                m:=q;
            q:=q^.next
        end;
        temp:=p^.number; 
        p^.number:=m^.number; 
        m^.number:=temp;
        p:=p^.next
    end
end;
 
begin
    InputSeq(lst);
    if IsSorted(lst) then begin
        DeleteMultiples(lst);
        DoublePrimes(lst);
    end
    else
        Sort(lst);
    OutputSeq(lst);
end.