сравнение с алфавитом

[RADik_bo]

ребят, дана строка,нужно напечатать слова, отличные от последнего слова, если они удовлетворяют следующему условию: слово совпадает с конечным отрезком латинского алфавита (z, yz, xyz и т.д.). После запуска программа не выдает результат. в чем ошибка?

program LABA3;
uses crt;
const alfafit='Z,Y,X,W,V,U,T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A';

var
 a: array[1..100] of string; 
 st,slov:string;
 i,j,n,q:integer;
 Flag:boolean;
{ввод данных и их проверка на условие} 
 begin
   while 1=1  do 
    begin
      writeln ('vvedite frazy:');
      readln (St);
      for i:=1 to length(st) do
        begin
         case st[i] of
         'a'..'z',' ':flag:=true;
         else
           begin
 writeln ('chto-to ne to');
 flag:=false;
 break;
 end;
end;
end;
if flag=true then break;
end;
while st[length(st)]=' ' do delete(st,length(st),1);
i:=1;
j:=1;
n:=length(st);
for i:=1 to n do 
begin 
 
if (st[i]<>' ') and (i<n) {Текст разбивается на слова и каждое слово заносится в ячейку массива} 
then slov:=slov+st[i] 
      else 
          begin 
if st[i]=' ' 
then a[j]:=slov 
else a[j]:=slov+st[i]; 
q:=j;{Переменной w присваевается последнее значение переменной j (последнее слово)} 
j:=j+1; 
 
slov:=''; 
 for j:=1 to q-1 do {Производиться сравнение всех слов с последним} 
if a[j]=a[q] 
then continue 
else 
begin 

if a[j]=copy(alfafit,1,length(a[j]))
then 
begin 
write(a[j]+' '); 
break; 

end;

end;

end;

writeln;

end;
end.

[challengerr]

begin -8 штук, end 9 штук. Программа не должна компилироваться.

program a;
uses crt;
var
st:string;
i, j, k, l, m, n:integer;
a1:array[1..100] of string;
b1: array[1..26] of char;

begin

b1[1] := 'z';
b1[2] := 'y';
b1[3] := 'x';
b1[4] := 'w';
b1[5] := 'v';
b1[6] := 'u';
b1[7] := 't';
b1[8] := 's';
b1[9] := 'r';
b1[10] := 'q';
b1[11] := 'p';
b1[12] := 'o';
b1[13] := 'n';
b1[14] := 'm';
b1[15] := 'l';
b1[16] := 'k';
b1[17] := 'j';
b1[18] := 'i';
b1[19]:='h';
b1[20]:='g';
b1[21]:='f';
b1[22]:='e';
b1[23]:='d';
b1[24]:='c';
b1[25]:='b';
b1[26]:='a';

j:=1;

for j:=1 to 100 do
begin
a1[j]:='';
end;

j:=1;

writeln('vvedite crazy:');
readln(st);

for i:=1 to length(st) do
begin
if st[i]<>' ' then
begin
a1[j]:=a1[j]+st[i];
end
else
begin
j:=j+1;
end;
end;

k:=j;
for j:=1 to k do
begin
if a1[j]<>a1[1] then
begin
l:=length(a1[j]);
n:=1;
m:=1;
while(a1[j][m] = b1[n]) and (n<=26) and (m<=1) do
begin
m:=m+1;
n:=n+1;
end;

if (m = l+1) then
begin
writeln(a1[j]);
end;

end;

end;

end.

Примерно следующим образом

[RADik_bo]

спасибо, там много лишнего потому что еще есть вторая часть задания, а вообще через a[j]=copy(alfafit,1,length(a[j])) где alfafit='Z,Y,X,W,V,U,T,S,R,Q,P,O,N, M,L,K,J,I,H,G,F,E,D,C,B,A'; можно сделать или неправильно мыслю?
P.S. не судите строго, я еще даже не поступил).

[Stilet]

Я бы так делал:

program Project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };
{
дана строка,нужно напечатать слова, отличные от последнего слова,
если они удовлетворяют следующему условию: слово совпадает с конечным отрезком латинского алфавита (z, yz, xyz и т.д.).}
var c,a,s:string;j,i:integer; b:boolean;
begin
  s:='zy hello xy is xy zy';c:='';
  for i:=Length(s) downto 0 do
   if s[i]=' ' then break else begin
     c:=s[i]+c;;
   end;
  i:=pos(' ',s);
  while i<>0 do begin
    b:=true;
    a:=copy(s,1,i-1);
    for j:=1 to length(a) do
     if not(a[j] in ['z','y','x']) or (c=a) then begin b:=false;break;end;
    if b then writeln(a);
    delete(s,1,i);
    i:=pos(' ',s);
  end;
  readln;
end.

[RADik_bo]

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

Я бы так делал:

program Project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };
{
дана строка,нужно напечатать слова, отличные от последнего слова,
если они удовлетворяют следующему условию: слово совпадает с конечным отрезком латинского алфавита (z, yz, xyz и т.д.).}
var c,a,s:string;j,i:integer; b:boolean;
begin
  s:='zy hello xy is xy zy';c:='';
  for i:=Length(s) downto 0 do
   if s[i]=' ' then break else begin
     c:=s[i]+c;;
   end;
  i:=pos(' ',s);
  while i<>0 do begin
    b:=true;
    a:=copy(s,1,i-1);
    for j:=1 to length(a) do
     if not(a[j] in ['z','y','x']) or (c=a) then begin b:=false;break;end;
    if b then writeln(a);
    delete(s,1,i);
    i:=pos(' ',s);
  end;
  readln;
end.

по мойму ты сравниваешь только с x y z а нужен весь алфавит.

[RADik_bo]

program labapoputka;
uses crt;
const
    alfafit='zyxwvutsrqponmlkjihgfedcba';
var
    a: array[1..100] of string; 
    st,slov,slov2:string;
    i,j,n,q,s:integer;
    Flag:boolean;
{ввод данных и проверка их на условие}    
begin
 while 1=1 do
   begin
    writeln('Vvedite vrazy:');
    readln(st);
     for i:=1 to length(st) do
      case st[i] of
       'a'..'z',' ':flag:=true;
      else
       begin
        writeln('chto-to ne to');
        flag:=false;
      break;
       end;
      end;
    if flag=true then break;
    end;
while st[length(st)]=' ' do delete(st,length(st),1);{удаляем лишние пробелы в конце строки}
{разбиваем строку на слова}
i:=1;
j:=1;
n:=length(st);
slov:='';
for i:=1 to n do 
 begin 
  if (st[i]<>' ') and (i<=n) {Текст разбивается на слова и каждое слово заносится в ячейку массива} 
   then slov:=slov+st[i] 
   else 
    begin 
     if st[i]=' ' 
      then a[j]:=slov 
      else q:=j;{Переменной w присваевается последнее значение переменной j (последнее слово)} 
           j:=j+1; 
           slov:=''; 
           q:=j;{Переменной w присваевается последнее значение переменной j (последнее слово)} 
     end;      
 end;
for j:=1 to q-1 do {Производиться сравнение всех слов с последним} 
if a[j]<>a[q] 
then begin
 if a[j]=copy(alfafit,1,length(a[j]))
            then writeln(a[j])
            end; 


       end.

[Stilet]

по мойму ты сравниваешь только с x y z а нужен весь алфавит.

А по-моему в задании сказано:

слово совпадает с конечным отрезком латинского алфавита (z, yz, xyz и т.д.)

Т.е. в нем нет никаких других букв кроме конечных.

[Serge_Bliznykov]

Т.е. в нем нет никаких других букв кроме конечных.

как же нет?
а это:

(z, yz, xyz и т.д.)

и "т.д." означает, что нужно проверять
z
yz
xyz
wxyz
vwxyz
uvwxyz
tuvwxyz
stuvwxyz

дальше, надеюсь, можно не продолжать?

[Stilet]

дальше, надеюсь, можно не продолжать?

Я понял по другому.
Впрочем видимо мой пример автор всетки отбросит.

[RADik_bo]

задание: Дана строка символов S, состоящая из латинских букв. Группы символов, разделенные пробелами и не содержащие пробелов внутри себя, будем называть словами. Преобразовать исходную строку в строки S1 и S2 в соответствии с пунктами 1 и 2 (п.1, п.2) заданий № 1 - 30. Если какая-либо из итоговых строк окажется пустой, выводить соответствующее сообщение.
п.1. – Напечатать слова, отличные от последнего слова, если они удовлетворяют следующему условию: слово совпадает с конечным отрезком латинского алфавита (z, yz, xyz и т.д.).
п.2. - Напечатать все слова, отличные от последнего слова, удаляя все гласные буквы.

program LABA3;
uses crt;
 
const alfafit='zyxwvutsrqponmlkjihgfedcba';
var
 a: array[1..100] of string; 
 st,slov:string;
 i,j,n,q,s,z,st3:integer;
 Flag:boolean;
{ввод данных и их проверка на условие} 
 begin
   while 1=1  do 
    begin
      writeln ('vvedite frazy:');
      readln (St); 
      for i:=1 to length(st) do
        begin
         case st[i] of
         'a'..'z',' ':flag:=true;
         else
           begin
 writeln ('chto-to ne to');
 flag:=false;
 break;
 end;
end;
end;
if flag=true then break;
end;
n:=length(st); 
j:=1;
z:=1; 
s:=1;
for i:=1 to n do 
begin 
if (st[i]<>' ') and (i<n) {Текст разбивается на слова и каждое слово заносится в ячейку массива} 
then slov:=slov+st[i] 
else 
begin 
if st[i]=' ' 
then a[j]:=slov 
else a[j]:=slov+st[i]; 
q:=j; {Переменной q присваевается последнее значение переменной j (последнее слово)} 
j:=j+1; 
slov:=''; 
end; 
end; 
for j:=1 to q-1 do {Производиться сравнение всех слов с последним} 
if a[j]=a[q] 
then continue 
else 

begin 
{Производиться поиск буквы аналогичной последней в каждом слове} 
if a[j]=copy(alfafit,1,length(a[j]))
then 
begin 
write(a[j]+'+'); 
s:=s+1;
end;
end;

writeln;{Вывод строки согласно условию №1}
if s=1 then Writeln('fraza ne alfafit libo vse kak poslednee');
for j:=1 to q-1 do {Производиться сравнение всех слов с последним} 
if a[j]=a[q]
then continue 
 else
 begin
 for i:=1 to length(a[j]) do {поиск буквы "q" в словах} 
 if a[j][i]=('e')
 then 
 Write(''){удаление}
 else 
   begin 
  if a[j][i]=('u')
     then
      Write('')
      else
     begin
       if a[j][i]=('i')
        then 
        Write('')
        else 
        begin
       if a[j][i]=('o')
        then
        Write('')
        else 
        begin
       if a[j][i]=('a')
       then   Write('')
             else 
             begin
             write(a[j][i]);
             z:=z+1;
             end;
 
  end;
   end;
    end;
     end;
     write(' '); 
 end;
writeln; {Вывод строки согласно условию №2} 
if z=1 then Writeln('odni glassnye libo vse kak poslednee');

readkey; 
end.