回 帖 发 新 帖 刷新版面

主题:[原创]再发一个读程序的题``

前面发的都太难了,这次发个简单的
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个回复)

沙发

你开始把K的值:=为1,然后for i:=1 to k do 是什么意思啊?

板凳

就是一开始做一次这样的循环啊..

3 楼

我说老兄,干吗复制偶的签名啊???

4 楼

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 楼

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的了

我来回复

您尚未登录,请登录后再回复。点此登录或注册