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

Автор: ganibal 15.12.2009 0:07

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

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

Автор: Lapp 15.12.2009 0:36

А круто было бы: приходишь в книжный, я там на на полках книги.. И все называются: "Книга из слов", "Книга, отпечатанная в типографии на бумаге", "Книга, написанная автором"..
Ты о чем думал, когда создавал тему в подразделе "Задачи" раздела "Паскаль"? Что там не хватает предлога "на"?.. Ну-ну..

М

Правила Форума, п.4 + правила раздела, п.1. Если не будет исправлено в течение часа - тема будет закрыта

Автор: ganibal 20.12.2009 3:06

Ни у кого идей по поводу этой задачи нет?

Автор: volvo 20.12.2009 3:09

А почему тут у кого-то должны быть идеи насчет ТВОЕЙ задачи? Идеи должны быть у тебя. Вот и выскажи их...

Автор: ganibal 20.12.2009 23:56

Вот написал прогу, но она не работает, вот где не пойму.

 program mass_3366;

{$APPTYPE CONSOLE}

uses
  SysUtils;
 const n=10;
	   m=10;
 type
	  bukvy=array[1..m] of char;
	  slova=array[1..n] of bukvy;
 var x:slova;
	 l,i,j:integer;
	 b,k:char;
	 found,ok:boolean;
begin
  i:=1;
  read(b);
  while b<>'.' do
	 begin
	   j:=1;
	   while (b=' ') and (b<>'.') do
		   read(b);
	   if b<>'.' then
		 while (b<>' ') and (b<>'.') do
		  begin
		   if (b>='a') and (b<='z') then
			  begin
				x[i,j]:=b;
				j:=j+1
			  end
			 else
			  writeln('owibka vvoda');
		   read(b);
		  end;
	   if b<>'.' then
		 begin
		   if j<m then
			  for j := j to m do
				x[i,j]:=' ';
		   i:=i+1
		 end
		   else
			begin
			  for j:= j to m do
				x[i,j]:=' ';
			  for i:=i to n do
				for j:= 1 to m do
				   x[i,j]:=' '
			end;
	 end;
  for i:=1 to n do
	 begin
	   j:=m;
	   found:=false;
	   while (j>=1) and not found do
		if x[i,j]<>' ' then
		  begin
			l:=j;
			found:=true
		  end
		 else j:=j-1;
	   while (j<l) and found do
		begin
		  if x[i,j]=x[i,l] then x[i,j]:=' ';
		  if x[i,j]<>' ' then writeln(x[i,j]);
		end;
	   write
	 end;
readln;
readln;
end.

Автор: Unconnected 21.12.2009 3:34

Автор: ganibal 21.12.2009 19:24

Цитата(Unconnected @ 20.12.2009 23:34)

Автор: ganibal 23.12.2009 0:54

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

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. 

Автор: volvo 23.12.2009 1:11

Введите текст
eraz  reza      dva tri chetire.
An unhandled exception occurred at $004014D7 :
ERangeError : Range check error
  $004014D7

Автор: ganibal 23.12.2009 1:50

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

Автор: volvo 23.12.2009 2:09

 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;

Автор: ganibal 23.12.2009 2:17

Цитата(volvo @ 22.12.2009 22:09)