Помогите пожалуйста...вот у меня программа...она сортирует текст но с каждой строкой заново...а мне надо переделать чтобы весь текст сортировался вместе...и ещё чтобы каждое слово было пронумеровано в соответствии с тем на каком месте оно стояло в исходном тексте...никак не могу понять как это сделать...помогите...
uses crt;
var
f1,f2:text;
a:array[1..100]of string;
b,t:string;
k,i,j:integer;
c:set of char;
begin
c:=['.',',',';',':','(',')','-','!','?'];
assign(f1,'input.txt');
assign(f2,'output.txt');
reset(f1);
rewrite(f2);
while not eof(f1) do
begin
clrscr;
readln(f1,b);
k:=0;
b:=' '+b;
for i:=1 to length(b) do
if b[i]=' 'then inc(k)
else if not (b[i] in c) then a[k]:=a[k]+b[i];
for i:=2 to k do begin
j:=i;
t:=a[i];
while (j>1) and (a[j-1]>t)do begin
a[j]:=a[j-1];
j:=j-1;
end;
a[j]:=t;
end;
for i:=1 to k do
write(f2,a[i],' ');
writeln(f2);
for i:=1 to k do
a[i]:='';
end;
writeln('END!!!');
readln;
close(f1);
close(f2);
end.
сделай 1 массив для слов, второй для хранения номеров. Останется отсортировать второй вместе с первым, чтоб не потерять исходного положения слов.
ооо...спасибо за программу...вот исходник:
Uses crt;
Var
f1,f2: text;
a: array[1..100] Of string;
b,t: string;
k,i,j: integer;
c: set Of char;
Begin
c := ['.',',',';',':','(',')','-','!','?'];
assign(f1,'input.txt');
assign(f2,'output.txt');
reset(f1);
rewrite(f2);
While Not eof(f1) Do
Begin
clrscr;
readln(f1,b);
k := 0;
b := ' '+b;
For i:=1 To length(b) Do
If b[i]=' 'Then inc(k)
Else If Not (b[i] In c) Then a[k] := a[k]+b[i];
For j:=2 To k Do
Begin
t := a[j];
While (j>1) And (a[j-1]>t) Do
Begin
a[j] := a[j-1];
j := j-1;
End;
a[j] := t;
End;
For i:=1 To k Do
write(f2,a[i],' ');
writeln(f2);
For i:=1 To k Do
a[i] := '';
End;
writeln('END!!!');
readln;
close(f1);
close(f2);
End.
Помогите пожалуйста...ничего в голову не лезет(