Informatika gyűjtemény

Egy szinttel feljebb haromszg.pas

2004050607080910

<<  21. óra  >>

<<  Háromszög  >>

NézetNyomtat

haromszg.pas (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: us-ascii
Méret: 6 KB
uses crt;

type typet = array[1..100,1..199] of record
           v:byte;
           voltunk:boolean;
     end;

var n:integer;
    t:typet;
    MAX_talalat:longint;


procedure keres(var i,fr:byte);
var a,b:byte;
    exit:boolean;
begin
     exit := false;
     for b:=1 to n do begin
     for a:=b to (n*2-b) do begin
         if( t[b][a].v = 1 ) and ( not t[b][a].voltunk ) then
         begin
              fr := a;
              t[b][a].voltunk := true;
              i:=b;
              exit := true;
              break;
         end;
     end;
     if( exit ) then break;
     end;
end;

procedure folytat(i, fr:byte; var talalat:longint);
var a:byte;
    hiba:boolean;
    b, x:byte;
    db:byte;
    save_talalat:longint;
begin
     {megprobaljuk hatarozni a haromszoget}
     {ha jo, akkor talalat-ot felul ir, majd torol}
     {ha nem, akkor is torol, mert mar nem tudjuk felhasznalni}

     {1. a haromszog lefele szelesedik}
     {  *  }
     { --- }
     {-----}

     db:=1; {az a lenyeg, hogy mindig ugy nezzuk, hogy a haromszogunk csucsa
     az, amit vizsgalunk, igy db = 1 mindig.
     }

     if(i mod 2 <> fr mod 2) then begin

         {ha egyaltalan befer}
         hiba:=false;

         {felfele megnezzuk, tehat amerre szukul}
         if ((db+1)div 2 -1) <> 0 then begin
         for a:=1 to ((db+1)div 2 -1) do begin
             {jelenlegi sor: i-a}
             {poz: fr+a}
             for b:=(fr+a) to (fr+a + db-2*a - 1) do begin
                 if( t[i-a][b].v = 0 ) then begin
                     {talaltunk nullat, ahol nem kene -> nem teljes haromszog}
                     hiba := true;
                     break;
                 end;
             end;
         end;

         if( not hiba ) then begin
             {nem volt hiba, teljes a haromszog, legalabbis fent}
             talalat := 0;
             a:=db;
             while (a<> 0) do begin
                 talalat := talalat+a;
                 if( a=1 ) then break;
                 dec(a, 2);
             end;
         end;
         end else begin
             {felfele nincs ertelme nezni}
         end;

         {lefele megnezzuk, tehat amerre szelesedik}

         hiba := false;
         save_talalat := talalat;

         for a:=1 to (n-i) do begin

             for b:=(fr-a) to (fr-a + db+2*a -1 ) do begin
                 if( t[i+a][b].v = 0 ) then begin
                     {talaltunk nullat, ahol nem kene -> nem teljes haromszog}
                     hiba := true;
                     break;
                 end;
             end;

             if( not hiba ) then begin
                 {volt +1 jo sorunk}
                 talalat := talalat+db+2*a;


             end else begin
                  {ha alul sem volt semmi, jo akkor max. 1}
                  if (save_talalat = talalat) then begin
                     talalat := 1;
                  end;
                  break; {kulonben lepjunk ki}
             end;

         end;

         if (MAX_talalat < talalat ) then MAX_talalat := talalat;

     end else


     {2. a haromszog lefele szukul}
     {-----}
     { --- }
     {  *  }

     if(i mod 2 = fr mod 2) then begin

         {lefele megnezzuk, tehat amerre szukul}
         if ((db+1)div 2 +i-1) <= n then begin
         for a:=1 to ((db+1)div 2 -1) do begin
             {jelenlegi sor: a+i}
             {poz: fr+a}
             for b:=(fr+a) to (fr+a + db-2*a - 1) do begin
                 if( t[i+a][b].v = 0 ) then begin
                     {talaltunk nullat, ahol nem kene -> nem teljes haromszog}
                     hiba := true;
                     break;
                 end;
             end;
         end;

         if( not hiba ) then begin
             {nem volt hiba, teljes a haromszog, legalabbis fent}
             talalat := 0;
             a:=db;
             while (a<> 0) do begin
                 talalat := talalat+a;
                 if( a=1 ) then break;
                 dec(a, 2);
             end;
         end;
         end else begin
             {lefele nem nezzuk a temat, mert mar nincs mit :D}
         end;

         {felfele megnezzuk, tehat amerre szelesedik}

         hiba := false;
         save_talalat := talalat;

         if( i-1 > 0 ) then begin
         for a:=1 to (i-1) do begin

             for b:=(fr-a) to (fr-a + db+2*a -1 ) do begin
                 if( t[i-a][b].v = 0 ) then begin
                     {talaltunk nullat, ahol nem kene -> nem teljes haromszog}
                     hiba := true;
                     break;
                 end;
             end;

             if( not hiba ) then begin
                 {volt +1 jo sorunk}
                 talalat := talalat+db+2*a;

             end else begin
                  {ha alul sem volt semmi, jo akkor max. 1}
                  if (save_talalat = talalat) then begin
                     talalat := 1;
                  end;
                  break; {kulonben lepjunk ki}
             end;

         end;
         end else begin
             {felfele nincs tobb hely, fogadjuk el, amit lent kaptunk}
         end;


         if (MAX_talalat < talalat ) then MAX_talalat := talalat;
     end;

end;

procedure szamol;
var db,fr:byte;
    i,x:byte;
    talalat:longint;
    marvolt:boolean;
begin
     {megkeressuk az osszes kicsi haromszoget, es megnezzuk, hogy lehet-e az
     egy haromszog csucs, ha igen, akkor az mekkora. A legnagyobbat eltaroljuk}
     MAX_talalat := 0;
     while (fr<>0) do begin
         {i. sor}
         db := 0;
         fr := 0;
         keres(i, fr); {megadja a kovetkezo egyes haromszoget}
         if( fr = 0 ) then break;
         talalat:=1; {biztosan legyen 1 -- lehet hogy nem kell}
         folytat(i, fr, talalat);
     end;
end;

procedure kiurit;
var a,b:byte;
begin
     for a:=1 to n do begin
         for b:=a to (n*2-a) do begin
                   t[a][b].v := 0;
                   t[a][b].voltunk:=false;
         end;
     end;
end;

procedure beolvas;
var f,fout:text;
    i,a:byte;
    s:string;
begin
     assign(f, 'harmszog.be');
     assign(fout, 'text.txt');
     rewrite(fout);
     reset(f);
     while true do begin
           readln(f, n);
           if( n = 0 ) then break;
           for i:=1 to n do begin
               readln(f, s);
               for a:=i to (n*2-i) do begin
                   if( s[a] = '-' ) then
                   t[i][a].v := 1 else t[i][a].v := 0;
                   t[i][a].voltunk := false;
               end;
           end;
           szamol;
           writeln(fout, max_talalat);
           kiurit;
     end;
     close(f);
     close(fout);
end;

begin
     clrscr;
     beolvas;
end.
(Vissza)