uses crt;
type
mas=array[0..100] of integer;
mas1=array[1..100] of integer;
Var
razm,razm1 : mas;
s : mas1;
m,n,k,f,kol : integer;
i,j : byte;
procedure output;
var i: integer;
begin
for i:=1 to m do write(s[razm[i]]);
end;
procedure output1;
var i: integer;
begin
for i:=1 to m do write(s[razm1[i]]);
end;
Begin
clrscr;
writeln ('Naidem razmeshenia iz n elementov no m');
writeln ('Enter n and m');
readln (n,m);
writeln ('Vvedite mn-vo razmerom n');
for i := 1 to n do
readln (s[i]);
writeln ('Mn-vo razmerom n:'); writeln;
for i := 1 to n do
write ( s[i]:5);
readln;
clrscr;
for i:=1 to m do razm[i]:=i;
for i:=1 to m do razm1[i]:=i;
kol := 0;
while i <> 0 do
begin
output; write(' '); kol := kol + 1;
for i := 1 to m do razm1[i] := razm[i];
repeat
i:=m;
while razm1[i-1]>razm1[i] do
i := i - 1;
j:=i-1;
f:=razm1[j];
while razm1[i+1]>f do
i := i + 1;
razm1[j]:=razm1[i];
razm1[i]:=f;
i:=j+1;
k:=m;
while i<k do
begin
f:=razm1[i];
razm1[i]:=razm1[k];
razm1[k]:=f;
i := i + 1;
k := k - 1
end;
output1; write(' '); kol := kol + 1;
until j=0;
i :=m;
while razm[i]=n-m+i do
i := i-1;
razm[i] := razm[i] + 1;
for j := i+1 to m do
razm[j] := razm[j-1] + 1;
end;
writeln;
writeln('Kol-vo razmeshenii:', kol);
readkey;
End.
Сообщение отредактировано: 18192123 -