Версия для печати темы

Автор: berg 24.01.2008 0:55

помогите исправить 2 ошибки, сил больше нет.
нужно сделать нормальную проверку на палиндромность и дублирование сделать с помощью insert, че-т не получается

const Nmax=100;
type T_Matrix = array[1..Nmax] of String;

procedure fill_array(var n: Integer; var a: T_Matrix);
var i,j,l: Integer;
        s: String;
  letters: Set of char;
begin
    letters:=['А'..'я'];
    read(s);
    l:=length(s);
    j:=1;
    i:=1;
    repeat
        a[j]:='';
        while (i<=l) AND NOT (s[i] in letters) do i:=i+1;
        if i>l then break;
        while (i<=l) AND (s[i] in letters) do begin
            a[j]:=a[j]+s[i];
            i:=i+1;
        end;
        j:=j+1;
    until i>l;
    n:=j-1;
end;

function num_vowels(s: String): Integer;
var    i,n: Integer;
    vowels: Set of char;
begin
    vowels:=['А','Е','И','О','У','Э','Ю','Я','а','е','и','о','у','э','ю','я'];
    n:=0;
    for i:=1 to length(s) do
        if s[i] in vowels then n:=n+1;
    num_vowels:=n;
end;

procedure sort_vowels(n: Integer; var a: T_Matrix);
var i,j: Integer;
    tmp: String;
begin
    for i:=1 to n-1 do
        for j:=i+1 to n do
            if num_vowels(a[j])>num_vowels(a[i]) then begin
                tmp:=a[i];
                a[i]:=a[j];
                a[j]:=tmp;
            end;
end;

procedure double_vowels(n: Integer; var a: T_Matrix);
var i,j,k,l: Integer;
          s: String;
     vowels: Set of char;
begin
    vowels:=['А','Е','И','О','У','Э','Ю','Я','а','е','и','о','у','э','ю','я'];
    for i:=1 to n do begin
        s:=a[i];
        l:=length(s);
        j:=1;
        repeat
            if s[j] in vowels then begin
                l:=l+1;
                setlength(s,l);
                for k:=l downto j+1 do s[k]:=s[k-1];
                j:=j+1;
            end;
            j:=j+1;
        until j>l;
        a[i]:=s;
    end;
end;

procedure sort_alphabet(n: Integer; var a: T_Matrix);
var i,j: Integer;
    tmp: String;
begin
    for i:=1 to n-1 do
        for j:=i+1 to n do
            if AnsiLowerCase(a[j])<AnsiLowerCase(a[i]) then begin
                tmp:=a[i];
                a[i]:=a[j];
                a[j]:=tmp;
            end;
end;


var i,n,l,tmp: Integer;
            s: String;
            a: T_Matrix;
begin
    reset(input,'input.txt');
    rewrite(output,'output.txt');
    fill_array(n,a);
    //
    tmp:=0;
    for i:=1 to n do begin
        s:=a[i];
        l:=length(s);
        if (l>1) AND (S[j])=(S[Length(S)-j+1]) then begin
            tmp:=1;
            sort_vowels(n,a);
            break;
        end;
    end;
    if tmp=0 then begin
        double_vowels(n,a);
        sort_alphabet(n,a);
    end;
    //
    for i:=1 to n do write(a[i],' ');
end.

Автор: мисс_граффити 24.01.2008 3:28

может, задание напишешь?...