Помощь - Поиск - Пользователи - Календарь
Полная версия: Двумерные массивы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
ganibal
Здраствуйте.
Вообщем вот задача, пожалуйста, у кого какие мысли есть:

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

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

ganibal
Ни у кого идей по поводу этой задачи нет?
volvo
А почему тут у кого-то должны быть идеи насчет ТВОЕЙ задачи? Идеи должны быть у тебя. Вот и выскажи их...
ganibal
Вот написал прогу, но она не работает, вот где не пойму.
 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
Цитата
предварительно удалив из каждого слова все предыдущие вхождения последней буквы.


Последней буквы всей последовательности или каждого слова?
ganibal
Цитата(Unconnected @ 20.12.2009 23:34) *

Последней буквы всей последовательности или каждого слова?

Именно каждого слова, то есть есть drgtg а надо вывести drtg. Итак с каждым словом.
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. 
volvo
Цитата
Вот конечный вариант проги, она точно работает.
У тебя странные понятия о работоспособности программы. Во-первых, твой вариант даже не компилируется: там запятая вместо точки с запятой... Даже после исправления: если программа вываливается на первом же примере, это не значит, что она работает:
Введите текст
eraz reza dva tri chetire.
An unhandled exception occurred at $004014D7 :
ERangeError : Range check error
$004014D7

(введено меньше 30 слов, указанных в первоначальном задании, в каждом - больше 2-х но меньше 10 букв. Все условия соблюдены. Программа ответ не выдала. Она работоспособна?)
ganibal
Да про точку с запятой спасибо. Прога у меня работает:Изображение.
И еще добавил пропуск пробелов, чтобы не мешались. Запускал через делфи.
volvo
Цитата
Прога у меня работает
ТЕПЕРЬ работает, хотелось бы заметить. Раньше у тебя
Цитата
 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
Цитата(volvo @ 22.12.2009 22:09) *

ТЕПЕРЬ работает, хотелось бы заметить. Раньше у тебя

Да я добавил пропуск пробелов, но от него ничего не менялось, просто в конце на выводе без него лишние пробелы выводились.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.