Informatika gyűjtemény

Egy szinttel feljebb fa_utv.dpr

2004050607080910

<<  7. óra  >>

<<  Feladatok  >>

NézetNyomtat

fa_utv.dpr (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 2 KB
{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q+,R+,S-,T-,U+,V+,W+,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}

PROGRAM utkereso;
uses
  SysUtils;

CONST
    n = 11; {sor}
    m = 21; {oszlop}

VAR
    map: ARRAY [0..n+1, 0..m+1] OF BOOLEAN; {true - fal ; false - semmi}
    ways: ARRAY [0..n+1, 0..m+1] OF BOOLEAN; {true - el lehet jutni a kiindulási pontba}
    volt : array [1..n,1..m] of boolean;

PROCEDURE Init;
VAR
    i, j: INTEGER;
BEGIN
    For i:=1 to n do
      For j:=1 to m do
        volt[i,j]:=false;

    For i:=1 to n do
      For j:=1 to m do
        If (i mod 2=0)and(j mod 2=0) then map[i,j]:=true
          else map[i,j]:=false;

    FOR i:= 0 TO n+1 DO
    BEGIN
        map[i, 0]:= TRUE; map[i, m+1]:= TRUE;
    END;
    FOR i:= 0 TO m+1 DO
    BEGIN
        map[0, i]:= TRUE; map[n+1, i]:= TRUE;
    END;
END; {Init}

PROCEDURE Dump;
VAR
    i, j: INTEGER;
BEGIN
    WriteLn('------------');
    FOR i:= 0 TO n+1 DO
    BEGIN
        FOR j:= 0 TO m+1 DO
          IF map[i, j] THEN Write('#') else Write(' ');
        WriteLn;
    END;
    WriteLn('------------');
END; {Dump}

FUNCTION Ut(s1, o1, s2, o2:INTEGER): BOOLEAN;
VAR
    i, j: INTEGER;
    keep: BOOLEAN;

    FUNCTION Add(i, j: INTEGER): BOOLEAN;
    BEGIN
        IF NOT (map[i, j]) AND NOT (ways[i, j]) THEN
        BEGIN
            ways[i, j]:= TRUE;
            Add:= TRUE;
        END
        ELSE Add:= FALSE;
    END; {Add}

BEGIN
    FOR i:= 0 TO n+1 DO
        FOR j:= 0 TO m+1 DO
            ways[i, j]:= FALSE;

    ways[s1, o1]:= TRUE;
    REPEAT
        keep:= FALSE;

        FOR i:= 1 TO n DO
        BEGIN
            FOR j:= 1 TO m DO
            BEGIN
                IF ways[i, j] = TRUE THEN
                BEGIN
                    IF Add(i+1, j) THEN keep:= TRUE;
                    IF Add(i-1, j) THEN keep:= TRUE;
                    IF Add(i, j+1) THEN keep:= TRUE;
                    IF Add(i, j-1) THEN keep:= TRUE;
                END;
            END;
        END;
    UNTIL NOT keep;
    Ut:= ways[s2, o2];
END; {Ut}

Procedure utkeres;
Var
  i,j,x,y,x1,y1,x2,y2 : integer;
  kilep               : boolean;
Begin
  Randomize;
  Repeat
    kilep:=true;
    Repeat
      x:=random(n)+1;
      y:=random(m)+1;
      volt[x,y]:=true;
    until (x+y)mod 2=1;

    map[x,y]:=true;

    If (x mod 2)=1 then
      Begin
        x1:=x;
        y1:=y-1;
        x2:=x;
        y2:=y+1;
      End else
      Begin
        x1:=x-1;
        y1:=y;
        x2:=x+1;
        y2:=y;
      End;

    If not ut(x1,y1,x2,y2) then map[x,y]:=false;

    For i:=1 to n do
      For j:=1 to m do
        kilep:=kilep and volt[i,j];

  until kilep;
End;

BEGIN
    Init;
    utkeres;
    Dump;
    ReadLn;
END.
(Vissza)