fork download
  1. program solitario;
  2.  
  3. var N,M,soluzione,area, arearimanente:longint;
  4. griglia:array[0..10,0..10] of longint;
  5.  
  6. function gioca(r, c: longint): boolean;
  7. begin
  8. (*tris orizzontale*)
  9. if (c-2>=0) and (griglia[r][c-2]=1) and (griglia[r][c-1]=1) then gioca:=false
  10. (*tris verticale*)
  11. else if (r-2>=0) and (griglia[r-2][c]=1) and (griglia[r-1][c]=1) then gioca:=false
  12. (* Tris diagonale in alto a sx*)
  13. 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
  14. (* Tris diagonale in alto a dx*)
  15. 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
  16. else gioca := true;
  17. end;
  18. Procedure riempi (riga:longint; colonna:longint; tot:longint);
  19. begin
  20.  
  21. arearimanente:=N*M-(M*(riga)+colonna+1);
  22. if tot+((2 div 3)*arearimanente)<soluzione then begin if tot>soluzione then soluzione:=tot; exit; end
  23. else begin
  24. if colonna=M then begin riga:=riga+1; colonna:=0; end;
  25. if riga=N then begin if tot>soluzione then soluzione:=tot; exit end;
  26. (*Se posso, metto la X*)
  27. if gioca (riga,colonna)=true then
  28. begin
  29. griglia[riga][colonna]:=1;
  30. Riempi(riga,colonna+1, tot+1);
  31. (* Reset della griglia[riga][col]*)
  32. griglia[riga][colonna]:=0;
  33. end;
  34. (* Non metto la X*)
  35. Riempi(riga,colonna+1, tot); end;
  36. end;
  37. begin
  38. readln(N,M);
  39. area:=N*M;
  40. soluzione:=0; riempi(0,0,0);
  41. writeln(soluzione);
  42. end.
Success #stdin #stdout 0s 5284KB
stdin
3 3
stdout
4