主题:[原创]再发一个读程序的题``
MagicG
[专家分:650] 发布于 2005-08-05 21:46:00
前面发的都太难了,这次发个简单的
var flag:boolean;
space,n,k,i,j,h:integer;
begin
readln(n);
space:=n;
k:=1;
flag:=true;
while flag do
for j:=1 to k do
begin
for h:=space downto 1 do write(' ');
for i:=1 to k do write('*');
for i:=k-1 downto 1 do write('*');
inc(k);
dec(space);
writeln;
if k>n then begin
flag:=false;
break;
end;
end;
for j:=k downto 1 do
begin
for h:=1 to space do write(' ');
for i:=k-1 downto 1 do write('*');
for i:=1 to k do write('*');
dec(k);
inc(space);
writeln;
if k<1 then break;
end;
end.
回复列表 (共5个回复)
沙发
yukangcool [专家分:460] 发布于 2005-08-06 10:11:00
你开始把K的值:=为1,然后for i:=1 to k do 是什么意思啊?
板凳
MagicG [专家分:650] 发布于 2005-08-06 13:44:00
就是一开始做一次这样的循环啊..
3 楼
MagicG [专家分:650] 发布于 2005-08-06 13:44:00
我说老兄,干吗复制偶的签名啊???
4 楼
zhyong07 [专家分:90] 发布于 2005-10-23 15:48:00
var
i : integer;
begin
i:=0;
repeat
inc(i);
until (i>lev) or (Timelength[i]=0);
Right:=i>lev;
end; {right}
PROCEDURE Search(t:integer);
var
i,j,k : integer;
function can:boolean;
begin
k:=t;
repeat
inc(k,j);
until (k>=60) or (State[k]=0);
can:=k>=60;
end; {can}
begin
while (t<60) and (State[t]=0) do inc(t);
if t=60
then begin
if (lev<best) and right
then begin
best:=lev;
for i:=1 to lev do
writeln(i:3,') ',Arrive[i]:4,Timelength[i]:4);
end; {then}
end {then}
else begin
for i:=0 to t-1 do
if Open[i]>=Closed[i]
then begin
j:=t-i;
if can then begin
k:=t;
repeat
dec(State[k]); inc(k,j);
until k>59;
Timelength[List[i,Closed[i]]]:=j;
inc(Closed[i]);
Search(t);
dec(Closed[i]);
Timelength[List[i,Closed[i]]]:=0;
k:=t;
while k<=59 do begin
inc(State[k]);
inc(k,j);
end; {while}
end; {for}
end; {then}
if (lev+1)〈best
then begin
inc(lev);
Arrive[lev]:=t;
inc(Open[t]);
List[t,Open[t]]:=lev;
dec(State[t]);
Search(t);
inc(State[t]);
dec(Open[t]);
dec(lev);
end; {then}
end; {else}
end; {search}
BEGIN
Assign(Output,’output.txt’);ReWrite(Output);
Init;
Search(0);
Close(Output);
END. {main}
5 楼
封天怒龙 [专家分:160] 发布于 2005-10-26 16:39:00
const maxn=15;
type arraytype=array [1..maxn*maxn,1..maxn*maxn] of byte;
var d,i,j,k,m,n,mind,nextp,t:longint;
p:array [1..maxn*maxn,1..2] of longint;
g:arraytype;
r:array [1..maxn,1..maxn] of longint;
v:array [1..maxn*maxn] of longint;
procedure dfs(k:longint);
var i:longint;
begin
if v[k]=0 then
begin
inc(t);
r[p[k,1],p[k,2]]:=t;
v[k]:=1;
for i:=1 to n*n do
if g[k,i]=1 then dfs(i)
end
end;
begin
n:=4;
k:=0;
for i:=1 to n do
for j:=1 to n do
begin
inc(k);
p[k,1]:=i;
p[k,2]:=j
end;
fillchar(g,sizeof(g),0);
for i:=1 to n*n-1 do
for j:=i+1 to n*n do
if abs((p[i,1]-p[j,1])*(p[i,2]-p[j,2]))=2
then begin g[i,j]:=1; g[j,i]:=1 end;
fillchar(v,sizeof(v),0);
t:=0;
dfs(1);
for i:=1 to n do
begin
for j:=1 to n do write(r[i,j]:4);
writeln
end;
end.
这可是the easiest的了
我来回复