Строки в Паскаль.

[Бумер]

program lab_7;var a,b,c,d,e:string;procedure slova(const a,b:string; var d,e:string);var i,j:byte;begini:=1; j:=1;while a[i]<>' ' do begind[i]:=a[i]; i:=i+1;end;d[i]:=' ';while b[j]<>' ' do begine[j]:=b[j]; j:=j+1; end;e[j]:=' ';end;procedure delete (const d,e:string; var a,b:string);var i,j,k,t:byte;begini:=length(d); j:=length(e);while k<(i+1) do begina[k]:=a[k+1]; k:=k+1;end;while t<(j+1) do beginb[t]:=b[t+1]; t:=t+1;end;end;procedure sum (const d,e:string; var c:string);beginc:=d+c;end;var x,z:byte;beginwriteln ('wwedite stroku');readln(a);writeln ('wtoraya stroka'); readln(b); x:=length(a); z:=length(b);while (z<>0) and (x<>0) do beginslova(a,b,e,d);delete(a,b,e,d);sum (c,d,e);x:=length(a);z:=length(b);end;end.

Даны две строки, надо получить строку, в которой чередуются слова первой и второй. Если не с чем чередовать, то просто добавить в конце. Дело в том, что я посмотрел в окно AD-Watch и что обнаружил: Если строки D и Е не приравнивать другой строке, то они не изменяются!!!!! Не понимаю почему так происходит, и в книжках объяснения этому я не нашел. Второе: Почему в данной программе происходит зацикливание??????. Извиняюсь, в конце вывод не поставил, но через Ad-Watch Можно посмотреть. да и недолго написать врайтлн.

[Bokrenok]

навскидку...

ты не путаешь глобальны переменные и локальные (в процедуре)?

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

переименовать бы надо... либо глобальные, либо локальные - путаницы гораздо меньше будет.

вот цикл

while a[i]<>' ' do begind[i]:=a[i]; i:=i+1;end;

а если одно слово? и без пробела в конце?

или несколько слов, но опять же после последнего слова нет пробела - цикл что делать будет?

дальше: странное удаление у тебя

i:=length(d);while k<(i+1) do begina[k]:=a[k+1]; k:=k+1;end;

во-первых k у тебя нигде не инициализируется (и не факт что оно в самом начале ноль)

во-вторых что вообще за цикл ? чего он такое делает?

ты наверное хотел строку "d" перегнать в строку "а" ... в итоге ты работаешь только со строкой "a" и делаешь что-то неясное.. посимвольно сдвигаешь строку влево.... причем отталкиваешься от длины строки "d", а изменяешь строку "a" (!)

дальше:

у тебя процедура

procedure delete (const d,e:string; var a,b:string);

а вызываешь ты ее вот так:

delete(a,b,e,d);

тем самым в качестве первого параметра процедуры ты ставишь строку "a", второй параметр - строка "b" и т.д.

т.е. в процедуре "const d,e" - это строки "a" и "b" - так и задумано?

дальше procedure sum (const d,e:string; var c:string);

ты ее вызываешь вот так: sum (c,d,e);

т.е. ты в строку "e" записываешь конкатенацию строк "c", "d" - это точно то, чего ты ожидаешь?

п.с. вообще странный какой-то код... и делает он что-то совсем не то, что подразумевается по заданию

напиши коменты, что ожидается от каждой процедуры типо такого

//процедура delete путем посимвольного перемещения стороку "a" перегоняет в строку "b"

//(хотя в такой реализации она этого не делает, но по задумке имхо должна)

Edited November 19, 2006 by Bokrenok

[Тролль]

Бумер:

Как ты ухитряешься из червяка делать спрута?

Например, процедура, в которой одна строка c:=a+b ? Не проще ли просто написать знак + ?

Почему в данной программе происходит зацикливание??????

А как цикл мог закончиться? Ни a, ни b у тебя в программе не меняются, их длины, само собой - тоже.

Насчет приравнивания строк d и e я даже вопроса не понял :) , тем более у тебя в процедурах e и d обозначают a и b, а в программе - наоборот. Можно свихнуться.

Во всяком случае, программные a и b в процедурах объявлены константами, так что меняться не могут.

Посмотри этот вариант

var a,b,c:string;procedure d(var s:string); var e:byte;begin e:=pos(' ',s); c:=c+copy(s,1,e); delete(s,1,e) end;beginreadln(a); readln(b);a:=a+' '; b:=b+' '; c:='';repeat d(a); d(b) until length(a)+length(b)=0;writeln( c);end. 

Всё!

[Бумер]

Тролль, дело в том, что нам запретили использовать все процедуры и функции кроме length, если надо говорят процедура, то сами пишите.

[Тролль]

Бумер:

кроме length

Да уж, большая помощь...

Вот текст ее аналога:

function length(s:string):byte; begin length:=byte(s[0]) end;

если надо говорят процедура, то сами пишите

Значит, напиши pos, delete и copy самостоятельно. "Тоже мне, бином Ньютона!" (кот Бегемот, "Мастер и Маргарита"). Или я напишу:

function pos(c:char; s:string):byte; var i:byte;begin pos:=0; for i:=1 to length(s) do if s[i]=c then begin pos:=i; break end end;procedure delete(var s:string; b,n:byte); var i:byte;begin for i:=b to length(s) do s[i]:=s[i+n-b+1]; s[0]:=char(length(s)-(n-b+1)); end;function copy(var s:string; b,n:byte):string; var i:byte;begin for i:=b to n do copy[i-b+1]:=s[b+i-1]; s[0]:=char(n-b+1) end;

Строго говоря, учитывая, что у нас один параметр всегда равен 1, можно было бы и упростить, но я написал полный аналог стандартных функций.

[Бумер]

А я вот какое сдал:

program a1;var a,b,c,z:string; i:byte;procedure del (var a:string);var i,j,t:byte;begin i:=1;while a[i]<>' ' do begini:=i+1;end;  t:=length(a);for j:=1 to t do a[j]:=a[j+i];t:=length(a); t:=t-i;a[0]:=chr(t);end;beginreadln (a); readln (b); b:=b+' '; a:=a+' '; z:=' ';while (length(a)<>0) or (length(b)<>0) do begin i:=1;if length(a)<>0 then beginwhile a[i]<>' ' do begin z:=a[i]; c:=c+z;i:=i+1; end;z:=' ';c:=c+z; del(a); i:=1;end;if length(b)<>0 then beginwhile (b[i]<>' ') and (length(b)>0) do begin z:=b[i]; c:=c+z; i:=i+1; end;z:=' ';c:=c+z; del(b); end;end;writeln ('otvet:',c);end.

Правда, я еще мелкие ошибки отсюда поисправлял....

Идея по моему неплохая, верно?

[Bokrenok]

Бумер:

немного о хорошем стиле программирования: зачем писать код одним сплошным текстом?

читабельности вообще никакой... гораздо лучше писать вот так:

program a1;var a,b,c,z:string; i:byte;procedure del (var a:string);var i,j,t:byte;begin i:=1;while a[i]<>' ' do begin	i:=i+1;end;  t:=length(a);for j:=1 to t do 	a[j]:=a[j+i]; {<----- вот тут ты вылетишь за пределы строки как только j >(t - i)}t:=length(a); t:=t-i;a[0]:=chr(t);end;beginreadln (a); readln (b); b:=b+' '; a:=a+' '; z:=' ';while (length(a)<>0) or (length(b)<>0) do begin 	i:=1;	if length(a)<>0 then 	begin		while a[i]<>' ' do 		begin		  z:=a[i]; 		  c:=c+z;		  i:=i+1; 		end;		z:=' ';		c:=c+z; 		del(a); 		i:=1;	end;	if length(b)<>0 then 	begin		while (b[i]<>' ') and (length(b)>0) do 		begin		  z:=b[i]; 		  c:=c+z; 		  i:=i+1; 	  end;		z:=' ';		c:=c+z; 		del(b);		i:=1; {<------помойму ты забыл вот эту строчку}	end;end;writeln ('otvet:',c);end.

сразу видно где какой цикл начинается/заканчивается и что в себя включает.

по поводу циклов:

if length(a)<>0 then 	begin		while a[i]<>' ' do 		begin		  z:=a[i]; 		  c:=c+z;		  i:=i+1; 	  end;		z:=' ';		c:=c+z; 		del(a); 		i:=1;	end;	if length(b)<>0 then 	begin		while (b[i]<>' ') and (length(b)>0) do 		begin		  z:=b[i]; 		  c:=c+z; 		  i:=i+1; 	  end;		z:=' ';		c:=c+z; 		del(b); 		i:=1; {<------помойму ты забыл вот эту строчку}	end;

не находишь что они идентичны? только для разных строк?

можно вместо них одну процедуру сделать и вызывать ее.

Edited November 23, 2006 by Bokrenok

[Бумер]

Насчет ошибок: Ты верно их нашел, но я же сказал, что потом чуток доработал, просто сейчас было в лом искать ошибку. А насчет процедуры и правда - стормозил я.