Никак не разберусь почему не работает..

[CodeExpert]

пишу себе лабу по программированию, не фига не пойму где ошибка, задание:Дана строка символов, содержащая русские слова, разделенные пробелами. Удалить из слов с четной длиной все гласные, а из слов с нечетной длинной – все согласные. Полученные слова вывести на экран в лексикографическом виде.
код:

program aaa;
uses Crt;
const gla: set of char=['А','а','Е','е','И','и','О','о','У','у','Ы','ы','Э','э',
     'Ю','ю','Я','я'];
      so:set of char=['Б','б','В','в','Г','г','Д','д','Ж','ж','З','з','К','к',
      'Л','л','М','м','Н','н','П','п','Р','р','С','с','Т','т','Ф','ф','Х','х',
      'Ц','ц','Ч','ч','Ш','ш','Щ','щ','Ъ','ъ','Ь','ь'];
var mas:array[1..50] of string;//массив слов
    q:integer;//счетчик слов
    str:string[255];//строка
    i:integer;//циклический счетчик
    slovo:string; //очередное слово
    n:integer;//счетчик для букв
    max,min:integer;
begin

{ввод строки}
Writeln('Введите строку');
readln(str);

{присвоение начального значения счетчикам}
i:=1;
q:=1;
repeat
 if str[i]=char(#32) then
    begin
      slovo:=copy(str,1,i-1);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      q:=q+1;//повышаем счетчик кол-ва слов
      delete(str,1,i);//удаляем использованное строчное слово
      i:=1; //присваиваем начальное значение
      end;
 if i=length(str) then
    begin
      slovo:=copy(str,1,i);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      {присваиваем значение больше длинны строки чтоб
      выйти из цикла}
      i:=length(str)+1;
      q:=q+1;
      end;
  i:=i+1;
until i>length(str);

{уменьшаем кол-во слов до реальности}
q:=q-1;

{выводим кол-во слов}
Writeln('Количество слов:= ',q);

{вид разобранной строки}
Writeln('Вид разобранной по словам строки:');
for i:=1 to q do
 begin writeln(mas[i]);end;
 
{разбираем каждое слово массива на составляющие}
i:=1; n:=1;
repeat 
slovo:=mas[i];
  if (length(slovo)mod 2 = 0) then
    begin
       repeat
           if slovo[n] in gla then
               begin
                  delete(slovo,n,1);
                   end;
                inc(n);
         until n>=length(slovo) 
           end;
  if not(length(slovo)mod 2 = 0) then
       begin
           repeat
                if slovo[n] in so then
                  begin
                   delete(slovo,n,1);
                   end;
                 inc(n);
          until n>=length(slovo);
          end;
mas[i]:=slovo;
inc(i);n:=1;
until i=q;

Writeln('результ:');
for i:=1 to q do
 begin writeln(mas[i]);end;
 readln;
 end.

Помогите плиз найти...!

[Анатоль]

Хорошая задача. говори что конкретно не работает в проге. говори ограничения на длину сторки и время выполнения программы.

[CodeExpert]

Не работает с последними буквами в слове и последними словами в строке, длинна строки до 255, во времени не ограничено

[mihali4]

Стандартная ошибка. Пример из вашей программы:

begin
delete(slovo,n,1);
end;
inc(n);

Теперь смотрим.
Вы удалили N-ю букву.
И тут же увеличили счетчик - и следующая анализируемая буква будет не та, которая следовала за удаленной, а через одну...
Вывод: инкремент счетчика только в том случае, если удаления не было...
Доступно?

[eoln]

Ещё парочка замечаний

repeat
slovo:=mas[i];
  if (length(slovo)mod 2 = 0) then
    begin
       repeat
           if slovo[n] in gla then
               begin
                  delete(slovo,n,1);
                   end else{см замечание mihali4}
                inc(n);
         until n>{=}length(slovo)//последний символ не обрабатывался
           end{;}
  else{if not(length(slovo)mod 2 = 0) then}//тут слово может ещё раз обработаться, т.к. его длина могла стать нечётной
       begin
           repeat
                if slovo[n] in so then
                  begin
                   delete(slovo,n,1);
                   end else{}
                 inc(n);
          until n{=}>length(slovo);
          end;
mas[i]:=slovo;
inc(i);n:=1;
until i{=}>q;{}//последнее слово не обрабатывалось

[CodeExpert]

Итак все равно не выводит результат:

program aaa;
uses Crt;
const gla: set of char=['А','а','Е','е','И','и','О','о','У','у','Ы','ы','Э','э',
     'Ю','ю','Я','я'];
      so:set of char=['Б','б','В','в','Г','г','Д','д','Ж','ж','З','з','К','к',
      'Л','л','М','м','Н','н','П','п','Р','р','С','с','Т','т','Ф','ф','Х','х',
      'Ц','ц','Ч','ч','Ш','ш','Щ','щ','Ъ','ъ','Ь','ь'];
var mas:array[1..50] of string;//массив слов
    q:integer;//счетчик слов
    str:string[255];//строка
    i:integer;//циклический счетчик
    slovo:string; //очередное слово
    n:integer;//счетчик для букв
    max,min:integer;
begin

{ввод строки}
Writeln('Введите строку');
readln(str);

{присвоение начального значения счетчикам}
i:=1;
q:=1;
repeat
 if str[i]=char(#32) then
    begin
      slovo:=copy(str,1,i-1);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      q:=q+1;//повышаем счетчик кол-ва слов
      delete(str,1,i);//удаляем использованное строчное слово
      i:=1; //присваиваем начальное значение
      end;
 if i=length(str) then
    begin
      slovo:=copy(str,1,i);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      {присваиваем значение больше длинны строки чтоб
      выйти из цикла}
      i:=length(str)+1;
      q:=q+1;
      end;
  i:=i+1;
until i>length(str);

{уменьшаем кол-во слов до реальности}
q:=q-1;

{выводим кол-во слов}
Writeln('Количество слов:= ',q);

{вид разобранной строки}
Writeln('Вид разобранной по словам строки:');
for i:=1 to q do
 begin writeln(mas[i]);end;

repeat
slovo:=mas[i];
  if (length(slovo)mod 2 = 0) then
    begin
       repeat
           if slovo[n] in gla then
               begin
                  delete(slovo,n,1);
                   end else{см замечание mihali4}
                inc(n);
         until n=length(slovo)//последний символ не обрабатывался
           end;
if not(length(slovo)mod 2 = 0) then//тут слово может ещё раз обработаться, т.к. его длина могла стать нечётной
       begin
           repeat
                if slovo[n] in so then
                  begin
                   delete(slovo,n,1);
                   end else{}
                 inc(n);
          until n=length(slovo);
          end;
mas[i]:=slovo;
inc(i);n:=1;
until i=q;{}//последнее слово не обрабатывалось

Writeln('результ:');
for i:=1 to q do
 begin writeln(mas[i]);end;
 readln;
 end.

((((((((((((((((((((

[mihali4]

Во-первых,

if not(length(slovo)mod 2 = 0) then//тут слово может ещё раз обработаться, т.к. его длина могла стать нечётной

заменяем на простое

ELSE...

чтобы не было ненужной обработки.

Где логическое мышление, Зин ?!

[CodeExpert]

Цитата:Где логическое мышление, Зин ?!

Сорри, Михалыч, мозг уже не работает, весь день пробыл на форуме, помогал, а теперь сожалею что не могу управлять своим временем, прийдется забросить лабу на после нг (((

[eoln]

Просто кусок из моего поста надо было скопировать, а вы опять за своё.

const gla: set of char=['А','а','Е','е','И','и','О','о','У','у','Ы','ы','Э','э',
     'Ю','ю','Я','я'];
      so:set of char=['Б','б','В','в','Г','г','Д','д','Ж','ж','З','з','К','к',
      'Л','л','М','м','Н','н','П','п','Р','р','С','с','Т','т','Ф','ф','Х','х',
      'Ц','ц','Ч','ч','Ш','ш','Щ','щ','Ъ','ъ','Ь','ь'];
var mas:array[1..50] of string;//массив слов
    q:integer;//счетчик слов
    str:string[255];//строка
    i:integer;//циклический счетчик
    slovo:string; //очередное слово
    n:integer;//счетчик для букв
    max,min:integer;
begin

{ввод строки}
Writeln('Введите строку');
readln(str);

{присвоение начального значения счетчикам}
i:=1;
q:=1;
repeat
 if str[i]=char(#32) then
    begin
      slovo:=copy(str,1,i-1);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      q:=q+1;//повышаем счетчик кол-ва слов
      delete(str,1,i);//удаляем использованное строчное слово
      i:=1; //присваиваем начальное значение
      end;
 if i=length(str) then
    begin
      slovo:=copy(str,1,i);//копируем очередное слово
      mas[q]:=slovo;//заносим его в массив
      {присваиваем значение больше длинны строки чтоб
      выйти из цикла}
      i:=length(str)+1;
      q:=q+1;
      end;
  i:=i+1;
until i>length(str);

{уменьшаем кол-во слов до реальности}
q:=q-1;

{выводим кол-во слов}
Writeln('Количество слов:= ',q);

{вид разобранной строки}
Writeln('Вид разобранной по словам строки:');
for i:=1 to q do
 begin writeln(mas[i]);end;

{разбираем каждое слово массива на составляющие}
i:=1; n:=1;
repeat
slovo:=mas[i];
  if (length(slovo)mod 2 = 0) then
    begin
       repeat
           if slovo[n] in gla then
               begin
                  delete(slovo,n,1);
                   end else{}
                inc(n);
         until n>length(slovo)
           end{;}
  else{if not(length(slovo)mod 2 = 0) then}
       begin
           repeat
                if slovo[n] in so then
                  begin
                   delete(slovo,n,1);
                   end else{}
                 inc(n);
          until n>length(slovo);
          end;
mas[i]:=slovo;
inc(i);n:=1;
until i>q;{}

Writeln('результ:');
for i:=1 to q do
 begin writeln(mas[i]);end;
 readln;
 end.

З.Ы. На счёт кодировки не уверен, с латинскими буквами всё нормально

[CodeExpert]

eoln, пожалуйста помоги прилепить лексикографическую сортировку сюда...