program ed;</br>
const maxn=6;</br>
type myarray=array[1..maxn+1] of byte;</br>
var a,last:myarray;</br>
i:integer;</br>
s:string;</br>
function eq(x,y:myarray;</br> n:integer):boolean;</br>
var i:integer;</br>
begin
i:=1;</br>
while (i<=n) and (x[i]=y[i]) do inc(i);</br>
eq:=(i>n);</br>
end;</br>
Begin
writeln('stroka');</br> readln(s);</br>
fillchar(a,sizeof(a),0);</br>
fillchar(last,sizeof(last),0);</br>
last[length(s)+1]:=1;</br>
while not(eq(a,last,(length(s)+1))) do begin
i:=1;</br>
while (i<=length(s)) and (a[i]=1) do begin
a[i]:=0;</br> inc(i);</br>
end;</br>
a[i]:=1;</br>
if i<=length(s) then
for i:=1 to length(s) do
if a[i]=1 then
write(s[i]);</br>
writeln;</br>
end;</br>
readln;</br>
End.