fork download
copy 
  1. program solitario; (*con procedura ricorsiva*)
  2. var N,M, soluzione:longint;
  3.     griglia:array[0..10,0..10] of longint;
  4.  
  5. function gioca(r, c: longint): boolean;
  6. begin
  7.       (*tris orizzontale*)
  8.    if (c-2>=0) and (griglia[r][c-2]=1) and (griglia[r][c-1]=1) then gioca:=false
  9.       (*tris verticale*)
  10.       else  if (r-2>=0) and (griglia[r-2][c]=1) and (griglia[r-1][c]=1) then gioca:=false
  11.     (* Tris diagonale in alto a sx*)
  12.       else if (r-2>=0 ) and (c-2>=0) and (griglia[r-2][c-2]=1) and (griglia[r-1][c-1]=1) then gioca:=false
  13.     (* Tris diagonale in alto a dx*)
  14.       else if (r-2>=0) and (c+2<=M) and (griglia[r-2][c+2]=1) and (griglia[r-1][c+1]=1) then gioca:=false
  15.           else   gioca := true;
  16. end;    
  17. Procedure riempi (riga:longint; colonna:longint; tot:longint);
  18.   begin
  19.     if colonna=M then begin riga:=riga+1; colonna:=0; end;
  20.     if riga=N then begin if tot>soluzione then soluzione:=tot; exit  end;
  21.       (*Se posso, metto la X*)
  22.     if gioca (riga,colonna)=true then
  23.                                     begin 
  24.                                         griglia[riga][colonna]:=1;
  25.                                         Riempi(riga,colonna+1, tot+1);
  26.                                           (* Reset della griglia[riga][col]*)
  27.                                         griglia[riga][colonna]:=0;
  28.                                     end;
  29.      if (tot+((M*N-(riga*M + colonna +1))))<soluzione  then exit; (*condizione per uscire dalla                                                procedura ricorsiva ed evitare di andare in TLE quando N*M>30;
  30.                                              se le x di questa soluzione + i 2/3 delle caselle libere < il                                              totale che ho già trovato in un' altra soluzione esco perchè non                                                ha senso continuare*)
  31.        (* Non metto la X*)
  32.     Riempi(riga,colonna+1, tot);
  33. end;                   
  34. begin
  35. 	readln(N,M);
  36. 	soluzione:=0;
  37.         riempi(0,0,0); 
  38.         writeln(soluzione);	
  39. end.
  40.  
Success #stdin #stdout 0s 5280KB
comments (?)
stdin
copy 
3 3
stdout
copy 
6
https://ideone.com/fFlFNv
language:
Pascal (fpc 3.0.4)
created:
7 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!