Условие: Задаётся некоторое слово, длина которого не превышает 80 символов, например GOTO. Из всех его букв составляются все возможные другие слова, может быть бессмысленные, например, GOOT, GOTO, GTOO, ..., TOOG. Каждая буква входит в образованное слово ровно столько же раз, сколько раз она встречается в исходном слове. Требуется написать программу, которая по заданному слову строит непосредственно следующее за ним по алфавиту слово в соответствии с описанным правилом.
Технические условия: Входной файл: INPUT.TXT. Выходной файл: OUTPUT.TXT. Ограничение по времени: 5 секунд на один тест. Входной файл INPUT.TXT содержит одно слово, состоящее не более чем из 80 заглавных английских букв. Выходной файл OUTPUT.TXТ содержит одно слово, непосредственно следующее в алфавитном порядке за заданным, или фразу "no words", написанную малыми английскими буквами, если нужного слова найти не удаётся.
Примеры входных и выходных файлов: Input.txt APAQ Output.txt APQA
Input.txt Z Output.txt no words
Решение: ---------- cut ---------- Конечно, не стоит искать все варианты перестановок заданного слова, а потом искать среди них нужный. Вместо этого предлагаю следующий алгоритм. Просматривая заданное слово с конца, ищем первую пару символов, стоящую не в порядке убявания. Затем сортируем полученный ряд символов (от найденной пары до конца слова) по возростанию, и, поставив на первое место символ, идущий следующим по порядку за тем что был в отрезке первым, получаем слово которое было необходимо найти. Выше изложенные мысли реализованы в программе: ---------- cut ----------
var i,j:integer; s,t,p,q:string; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); readln(s); i:=length(s); while (s[i]<=s[i-1]) and (i<>1) do inc(i,-1); t:=copy(s,i-1,length(s)-i+2);delete(s,i-1,length(s)-i+2); q:=copy(t,1,1);if i=1 then q:='no words'; for i:=1 to length(t)-1 do begin for j:=1 to length(t)-1 do begin if t[j]>t[j+1] then begin p:=copy(t,j,1); delete(t,j,1); insert(p,t,j+1); end; end; end; i:=pos(q,t); while t[i]=t[i+1] do inc(i); s:=s+t[i+1];delete(t,i+1,1);s:=s+t; if q='no words' then s:=q; write(s); end.