С этой задачей в паскале я мурыжусь уже третий день
вот, я как бы уже всё попробовал(или почти всё... Раньше она не проходила разные тесты, сейчас она не проходит по времени... я думаю, что это из-за неудобной медленной сортировки... Посмотрите и помогите мне плиззз
условие:
Одна из новых возможностей текстового редактора «World ХР» — это сортировка слов в предложении. Выход новой бета-версии редактора должен состоятся не позднее, чем через пять часов, а заявленная функция еще не реализована.
Требуется написать программу, осуществляющую сортировку слов в предложении. При этом все символы, отличные от букв, должны сохранится и не поменять своего положения относительно вхождений слов. Для упрощения при подаче входных данных на вход вашей программы все такие символы будут заменены на символ «.» (точка). Таким образом символ «.» имеет смысл разделителя между словами. Например, строка « . . aba. а. . Ьа» после сортировки пример вид « . . а. aba. . ba», а строка «с. . bb. а» примет вид «а. . bb. с». Слова следует сортировать лексикографически, как в словаре.
Формат ввода:
Входной файл содержит единственную строку, содержащую только прописные латинские буквы и символ «.». Слова могут разделяться любым количеством символов «.», строка может как начинаться так и заканчиваться последовательностью точек. Длина заданной строки не менее 1 символа и не превосходит 10^5 символов.
Формат вывода:
В выходной файл выведите строку после сортировки слов в ней.
Пример ввода: Пример вывода:
..aba.а..ba
..a.aba..ba
с.bb.а
a.bb.с
Моё решение:
var
s,s1 : ansistring;
t,buff,min: string;
a,b,c : array[1..100000] of string;
i,j,d,n,k : longint;
begin
assign(input,'d.in'); reset(input);
assign(output,'d.out'); rewrite(output);
readln(s);
d:=length(s);
if s[1] = '.' then
k:= 0
else k:= 1;
i:=1;k:=1;
for i:=1 to length(s) do begin
if s[i]<>'.' then
a[k]:=a[k]+s[i]
else begin
if i=length(s) then break;
if (s[i]<>'.') and (s[i+1]='.') then break else
if (s[i]='.') and (s[i+1]<>'.')then
begin inc(k); end; end;
end;
if (k = 0) or (k = 2) then writeln(s) else
begin
b:= a;
for i:= 1 to k-1 do
begin
min:= a[i];
n:= i;
for j:= i+1 to k do
if min > a[j] then
begin
min:= a[j];
n:= j;
end;
buff:= a[i];
a[i]:= a[n];
a[n]:= buff;
end;
n:= 0;
i:= 0;
repeat
inc(i);
if s[i] = '.' then s1:=s1+s[i] else
begin
inc(n);
s1:=s1+a[n];
i:= i + length(b[n])-1;
end;
until i >= length(s);
end;
d:=1;
write(s1);
Close(input);
Close(output);
end.