プログラミングウウウウウウウウウウウ

さっぱりわからない……。
というわけで嫌がらせのように貼り付けてみます。
どうも黄色の部分以下に問題があるみたいなんですが……。

なんて、Pascalの問題はさておき。
この問題を考えるのに1時間ぐらいかかりました。
でも最終的に駄目でした、私にはもう無理だ……、先にいけっ!
空白を新しく作り出す元気すらありません。

……この記事、読んでて絶対面白くないだろうな……。
たまにはそういうこともあるということで勘弁してください。

それでは。





program t2009(input, output);
const size = 100;
type index = 0 .. size;
nInt = record
n : index;
a : array [index] of integer
end;

procedure swap(var x, y : integer);
var w : integer;
begin
w := x; x := y; y := w
end;

function p(var x : nInt) : Boolean;
var i, j : index;
begin
with x do begin
a[0] := - maxint - 1; i := n - 1;
while a[i] >= a[i+1] do i := i - 1;
if i = 0 then p := false
else begin p := true;
j := n;
while a[i] >= a[j] do j := j - 1;
swap(a[i], a[j]);
i := i + 1; j := n;
while i < j do begin swap(a[i], a[j]); i := i + 1; j := j - 1 end
end

end

end;

function q(var x : nInt) : Boolean;
var i, j : index;
begin
with x do begin
a[0] := maxint; i := n - 1;
while a[i] <= a[i+1] do i := i - 1;
if i = 0 then q := false
else begin q := true;
j := n;
while a[i] <= a[j] do j := j - 1;
swap(a[i], a[j]);
i := i + 1; j := n;
while i < j do begin swap(a[i], a[j]); i := i + 1; j := j - 1; end
end

end

end;

procedure test;
var x : nInt; i : index;
k : integer;
begin
read(k);
if (0 < k) and (k <= size) then begin
x.n := k; for i := 1 to k do read(x.a[i]); readln;
readln(k);

while (k > 0) and p(x) do begin
for i := 1 to x.n do write( ' ', x.a[i]:1); writeln;
k := k - 1
end


while (k < 0) and q(x) do begin
for i := 1 to x.n do write( ' ', x.a[i]:1); writeln;
k := k + 1
end


end

end;

begin test end.
[PR]
by aftschool-student | 2009-10-15 13:41 | 日記