Двумерные массивы Опции

[ganibal]

Здраствуйте.
Вообщем вот задача, пожалуйста, у кого какие мысли есть:

Пусть дана последовательность, содержащая от 2 до 30 слов, в каждом из которых от 2 до 10 строчных латинских букв; между соседними словами - не менее одного пробела, за последним словом-точка. Напечатайте все слова, отличные от первого слова, предварительно удалив из каждого слова все предыдущие вхождения последней буквы.

Сообщение отредактировано: ganibal - 14.12.2009 21:12

[ganibal]

Вот конечный вариант проги, она точно работает.

program mass3366;

{$APPTYPE CONSOLE}

uses
  SysUtils;
const n=10;
	  m=30;

type bukvy=array[1..m] of char;
	 ttext=array[1..n] of bukvy;
var
 i,j,k,pow:integer;
 txt:ttext;
 slovo:array[1..m] of integer;
 ch:char;
 ok:boolean;
begin
 writeln('Введите текст');
 i:=1;
 while (i<>m+1)and(ch<>'.') do
  begin
   j:=1;
   read(ch);
   while (ch=' ') and (ch<>'.') do
    read(ch);
   while (ch<>' ')and(j<>n+1)and(ch<>'.') do
	begin
	 txt[i,j]:=ch;
	  j:=j+1;
	  read(ch)
	end;
   slovo[i]:=j-1;
   i:=i+1
  end;
 readln;
 k:=i-1;
 for i:=1 to k do
  begin
   j:=1;pow:=1;
   while(j<slovo[i]+1)do
   begin
	while txt[i,j]=txt[i,slovo[i]] do
	 begin
	  while pow<slovo[i]-1 do
	   begin
		ch:=txt[i,pow];
		txt[i,pow]:=txt[i,pow+1];
		txt[i,pow+1]:=ch;
		pow:=pow+1
	   end;
	  pow:=j; slovo[i]:=slovo[i]-1
	 end;
	 j:=j+1;pow:=j
	end;
  end;
for i:=1 to k do slovo[i]:=slovo[i]+1;
for j := 1 to slovo[1] do write(txt[1,j]);
writeln;
for i:=2 to k do
 begin
   ok:=true;
   if slovo[i]<>slovo[1] then
						  begin
						   for j := 1 to slovo[i] do write(txt[i,j]);
						   writeln
						  end
						 else
						  begin
						   j:=1;
						   while (j<slovo[i]+1)and OK do
							begin
							  if txt[i,j]=txt[1,j] then OK:=false;
							  j:=j+1
							end;
							if OK then begin
										 for j:=1 to slovo[i] do write(txt[i,j]);
										 writeln
									   end;
						  end
 end;
 readln
end. 

Сообщение отредактировано: ganibal - 22.12.2009 21:42