Newsgroup: it.comp.lang.pascal
Titolo: cerco aiuto per questo programma

Lo so che dovrei vedermela da solo, ma a quanto pare non ci riesco... Se
qualcuno di voi se la sente di perderci un po' di tempo per trovare gli
errori di preogettazione mi farà un grande favore. Nel caso aveste un idea
migliore per realizzarlo, ditelo, che mi adeguerò subito.
Ecco la traccia:
Fare un programma che prende in input una matrice di celle (max 20x20) e
trova tutti i blocchi di celle nere, contando quanti sono e da quante celle
sono composti. Un blocco di celle nere è costituito o da una sola cella nera
o da più celle nere aventi almeno un lato in comune.
Il file di input si chiama "grid.txt", mentre quello di output si chiama
"output.txt".
Il file input è costituito da due righe contenenti rispettivamente il numero
di righe e colonne, e da tante lettere "b" o "n" quanto l'area della
griglia, disposte ovviamente secondo il numero di righe e colonne
specificato.
Contenuto del file "input.txt"
5
5
nnbbb
nnbbb
bbbbb
bbbbn
bbbbn
/* Fine */
program copia (output, infile, outfile);
type pcella = ^cella;
     pmatrice= ^matrice;
     cella = record
          val : char;
          flag : 0..1;
          u,d,l,r : pmatrice;
          end;
     matrice = array [1..20] of array [1..20] of cella;
var infile, outfile: text; ch: char; i,j,row,col: 1..20; counter: integer;
    Grid: matrice; s: string;
procedure inizia(s: string);
begin
     writeln('sto eseguendo: ',s)
end;
procedure finisci(s: string);
begin
     writeln('Ho terminato: ',s)
end;
procedure set_p_To_nil(var griglia: matrice);
begin
        inizia('set_To_nil');
 griglia[j][i].u:=nil;
 griglia[j][i].d:=nil;
 griglia[j][i].l:=nil;
 griglia[j][i].r:=nil;
        finisci('set_To_nil');
end;
procedure activateP(var griglia: matrice);
begin
     inizia('activateP');
 if ((j-1)>0) then griglia[j-1][i].r :=  @griglia[j][i];
 if ((i-1)>0) then griglia[j][i-1].d :=  @griglia[j][i];
        if ((j+1)<21) then griglia[j+1][i].l := @griglia[j][i];
 if ((i+1)<21) then griglia[j][i+1].u := @griglia[j][i];
     finisci('activateP')
end;
procedure set_f_To_0(var griglia: matrice);
begin
        inizia('set_f_To_0');
 griglia[j][i].flag := 0;
        finisci('set_f_To_0')
end;
procedure ScanDown(var q: cella); forward;
procedure ScanLeft(var q: cella); forward;
procedure ScanRight(var q: cella); forward;
procedure ScanUp(var q: cella);
begin
     inizia('scanUp');
 if q.flag=0 then
 begin
  counter:=counter+1;
  q.flag:=1;
  while (q.u <> nil) AND (q.u^.flag = 0) do
   scanUp(grid[j][i-1]);
  if (q.r <> nil) AND (j+1<=20) then scanRight(grid[j+1][i]);
  if (q.l <> nil) AND (j-1>=1) then scanLeft(grid[j-1][i]);
  if (q.d <> nil) AND (i+1<=20) then scanDown(grid[j][i+1])
 end;
     finisci('scanUp')
end;
{ ScanUp esegue anche scanDown perchS l'ordine di ricerca inizia sempre
verso l'alto,
 quindi deve per forza controllare anche la cella sottostante.}
procedure ScanDown;
begin
     inizia('scanDown');
 if q.flag=0 then
 begin
  counter:=counter+1;
  q.flag:=1;
  while (q.d <> nil) AND (q.d^.flag = 0) AND (i+1<=20) do
   scanDown(grid[j][i+1]);
  if (q.r <> nil) AND (j+1<=20) then scanRight(grid[j+1][i]);
  if (q.l <> nil) AND (j-1>=1) then scanLeft(grid[j-1][i])
 end;
     finisci('scanDown')
end;
procedure ScanLeft;
begin
     inizia('scanLeft');
 if q.flag=0 then
 begin
  counter:=counter+1;
  q.flag:=1;
  while (q.l <> nil) AND (q.l^.flag = 0) AND (j-1>=1) do
   scanLeft(grid[j-1][i]);
  if (q.u <> nil) AND (i-1>=1) then scanUp(grid[j][i-1]);
  if (q.d <> nil) AND (i+1<=20) then scanDown(grid[j][i+1])
 end;
     finisci('scanLeft')
end;
procedure ScanRight;
begin
     inizia('scanRight');
 if q.flag=0 then
 begin
  counter:=counter+1;
  q.flag:=1;
  while (q.r <> nil) AND (q.r^.flag = 0) AND (j+1<=20) do
   scanRight(grid[j+1][i]);
  if (q.u <> nil) AND (i-1>=1) then scanUp(grid[j][i-1]);
  if (q.d <> nil) AND (i+1<=20) then scanDown(grid[j][i+1])
 end;
     finisci('scanRight')
end;
begin
        writeln('Comincio');
 assign(infile, 'grid.txt');
        writeln('1');
 assign(outfile, 'output.txt');
        writeln('2');
 reset(infile); rewrite(outfile);
        writeln('3');
        writeln('Ho letto e resettato i files');
 readln(infile, row);
 readln(infile, col);
        writeln('Ho letto le colonne e le righe');
 for j:=1 to row do
        begin
  for i:=1 to col do
  begin
   read(infile, ch);
   grid[j][i].val:=ch;
   set_p_To_nil(grid);
   set_f_To_0(grid)
  end
        end;
        writeln('Ho finito di memorizzare i dati nell''array');
 for j:=1 to row do
 begin
  for i:=1 to col do
   if grid[j][i].val='n' then activateP(grid)
 end;
 for j:=1 to row do
 begin
  for i:=1 to col do
  begin
   if grid[j][i].val='n' then scanUp(grid[j][i-1]);
   if counter<>0 then writeln(outfile,'Trovato un blob di ',counter:2,'
celle.');
                        counter:=0;
  end
 end;
close(outfile);
end.
--
San Vegeta from Hell
http://www.geocities.com/Area51/Dungeon/8436
(da visualizzare col browser della Netscape)

o da più celle nere aventi almeno un lato in comune.
Ciao, ti ho riscritto il programma funzionante, devi solo adattarlo
per la lettura da disco delle informazioni.
const MAX = 20 ;
type tipo_cella = (BIANCO, NERO) ;
type tipo_matrice_lavoro = array [1..MAX, 1..MAX] of tipo_cella ;
     tipo_matrice_passaggi = array [1..MAX, 1..MAX] of boolean ;
var ml   : tipo_matrice_lavoro ;
    mp   : tipo_matrice_passaggi ;
    dimx : word ;
    dimy : word ;
    contatore_blocchi : word ;
    contatore_celle   : word ;
    function libero_passaggio(x, y : word) : boolean ;
    begin
      libero_passaggio := false ;
      if (x >= 1) and (x <= dimx) and
         (y >= 1) and (y <= dimy) then
        if (ml [x, y] = NERO) and (not mp [x, y]) then
          libero_passaggio := true ;
    end ;
    procedure occupa_passaggio(x, y : word) ;
    begin
      mp [x, y] := true ;
    end ;
    procedure analisi_cella(i, j : word) ;
    begin
      occupa_passaggio(i, j) ;
      inc(contatore_celle) ;
      if libero_passaggio(i, j-1) then analisi_cella(i, j-1) ;
      if libero_passaggio(i-1, j) then analisi_cella(i-1, j) ;
      if libero_passaggio(i, j+1) then analisi_cella(i, j+1) ;
      if libero_passaggio(i+1, j) then analisi_cella(i+1, j) ;
    end ;
    procedure converti_riga_testo(j : word ; s : string) ;
    var i : word ;
    begin
      for i := 1 to length(s) do
        if (s[i] = 'n') then ml [i, j] := NERO
        else
        if (s[i] = 'b') then ml [i, j] := BIANCO ;
    end ;
    procedure azzera_mp ;
    begin
      fillchar(mp, sizeof(mp), false);
    end;
    function trova_elemento(var i, j : word) : boolean ;
    var _i, _j : word ;
    begin
      trova_elemento := false ;
      for _i := 1 to dimx do
        for _j := 1 to dimy do
          if (ml [_i, _j] = NERO) and
             (not mp [_i, _j]) then
          begin
            i := _i ;
            j := _j ;
            trova_elemento := true ;
            exit ;
          end;
    end;
    procedure calcola_blocchi_neri ;
    var x, y : word ;
    begin
      azzera_mp ;
      contatore_blocchi := 0 ;
      while (trova_elemento(x, y)) do
      begin
        contatore_celle := 0 ;
        analisi_cella(x, y) ;
        inc(contatore_blocchi) ;
        writeln('individuato blocco ', contatore_blocchi,
                ' in posizione (',x,',',y,') di ',
                contatore_celle, ' celle');
      end ;
    end ;
begin
  dimx := 10 ;
  dimy := 10 ;
  converti_riga_testo( 1, 'bbnbbbnnbb') ;
  converti_riga_testo( 2, 'bbbbnnnnnb') ;
  converti_riga_testo( 3, 'bnnbnnbnnb') ;
  converti_riga_testo( 4, 'bnbbbbbbnb') ;
  converti_riga_testo( 5, 'bbbbbbbnbb') ;
  converti_riga_testo( 6, 'bbnbbbnnbb') ;
  converti_riga_testo( 7, 'bbbbnnnnnb') ;
  converti_riga_testo( 8, 'bnnbnnbnnb') ;
  converti_riga_testo( 9, 'bnbbbbbbnb') ;
  converti_riga_testo(10, 'bbbbbbbnbb') ;
  calcola_blocchi_neri ;
end.

     matrice = array [1..20] of array [1..20] of cella;
Ad esempio in questo caso, perche' definire dei puntatori ?
In realta' la struttura della matrice e' molto semplice.
Non c'e' bisogno di conservare tante informazioni per ogni cella.
Addirittura sembra che ogni cella punti a 4 matrici differenti !
La notazione array[...] of array[...] viene poi inglobata in
array[...,...] cioe' nel tuo caso :
array [1..20, 1..20] of cella ;

 word appunto).
Grazie per l'aiuto. Non volevo utilizzare word e string perchè devo fare il
porting del sorgente per il MAC. In laboratorio usiamo il think pascal, ma
io non ci ho mai messo mano e non so quali sono i tipi predefiniti su quel
compilatore.