diff --git a/applications/sudoku/sudoku.lpi b/applications/sudoku/sudoku.lpi new file mode 100644 index 000000000..0cff6489c --- /dev/null +++ b/applications/sudoku/sudoku.lpi @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/sudoku/sudoku.lpr b/applications/sudoku/sudoku.lpr new file mode 100644 index 000000000..2725cae09 --- /dev/null +++ b/applications/sudoku/sudoku.lpr @@ -0,0 +1,37 @@ +program sudoku; + +{$mode objfpc}{$H+} + +{ + *************************************************************************** + * Copyright (C) 2006 Matthijs Willemstein * + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} + +uses + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, sudokumain; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/applications/sudoku/sudokumain.lfm b/applications/sudoku/sudokumain.lfm new file mode 100644 index 000000000..ae4fcad99 --- /dev/null +++ b/applications/sudoku/sudokumain.lfm @@ -0,0 +1,63 @@ +object Form1: TForm1 + Left = 571 + Height = 281 + Top = 355 + Width = 272 + HorzScrollBar.Page = 271 + VertScrollBar.Page = 280 + ActiveControl = ButtonFill + Caption = 'Form1' + ClientHeight = 281 + ClientWidth = 272 + PixelsPerInch = 75 + object Label1: TLabel + Left = 44 + Height = 13 + Top = 8 + Width = 39 + Caption = 'Label1' + Color = clNone + ParentColor = False + end + object StringGrid1: TStringGrid + Left = 44 + Height = 182 + Top = 40 + Width = 182 + ColCount = 9 + DefaultColWidth = 20 + FixedColor = clBtnFace + FixedCols = 0 + FixedRows = 0 + GridLineWidth = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + RowCount = 9 + ScrollBars = ssAutoBoth + TabOrder = 2 + TabStop = True + VisibleColCount = 9 + VisibleRowCount = 9 + OnDrawCell = StringGrid1DrawCell + OnSetEditText = StringGrid1SetEditText + end + object ButtonFill: TButton + Left = 44 + Height = 25 + Top = 228 + Width = 75 + BorderSpacing.InnerBorder = 2 + Caption = 'Fill' + OnClick = ButtonFillClick + TabOrder = 0 + end + object ButtonSolve: TButton + Left = 151 + Height = 25 + Top = 228 + Width = 75 + BorderSpacing.InnerBorder = 2 + Caption = 'Solve' + OnClick = ButtonSolveClick + TabOrder = 1 + end +end diff --git a/applications/sudoku/sudokumain.lrs b/applications/sudoku/sudokumain.lrs new file mode 100644 index 000000000..8006f0115 --- /dev/null +++ b/applications/sudoku/sudokumain.lrs @@ -0,0 +1,23 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3';'#2#6'Height'#3#25#1#3'Top'#3'c'#1#5'Wid' + +'th'#3#16#1#18'HorzScrollBar.Page'#3#15#1#18'VertScrollBar.Page'#3#24#1#13'A' + +'ctiveControl'#7#10'ButtonFill'#7'Caption'#6#5'Form1'#12'ClientHeight'#3#25#1 + +#11'ClientWidth'#3#16#1#13'PixelsPerInch'#2'K'#0#6'TLabel'#6'Label1'#4'Left' + +#2','#6'Height'#2#13#3'Top'#2#8#5'Width'#2''''#7'Caption'#6#6'Label1'#5'Colo' + +'r'#7#6'clNone'#11'ParentColor'#8#0#0#11'TStringGrid'#11'StringGrid1'#4'Left' + +#2','#6'Height'#3#182#0#3'Top'#2'('#5'Width'#3#182#0#8'ColCount'#2#9#15'Defa' + +'ultColWidth'#2#20#10'FixedColor'#7#9'clBtnFace'#9'FixedCols'#2#0#9'FixedRow' + +'s'#2#0#13'GridLineWidth'#2#0#7'Options'#11#15'goFixedVertLine'#15'goFixedHo' + +'rzLine'#10'goVertLine'#10'goHorzLine'#13'goRangeSelect'#9'goEditing'#14'goS' + +'moothScroll'#0#8'RowCount'#2#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2 + +#2#7'TabStop'#9#15'VisibleColCount'#2#9#15'VisibleRowCount'#2#9#10'OnDrawCel' + +'l'#7#19'StringGrid1DrawCell'#13'OnSetEditText'#7#22'StringGrid1SetEditText' + +#0#0#7'TButton'#10'ButtonFill'#4'Left'#2','#6'Height'#2#25#3'Top'#3#228#0#5 + +'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#4'Fill'#7'OnClic' + +'k'#7#15'ButtonFillClick'#8'TabOrder'#2#0#0#0#7'TButton'#11'ButtonSolve'#4'L' + +'eft'#3#151#0#6'Height'#2#25#3'Top'#3#228#0#5'Width'#2'K'#25'BorderSpacing.I' + +'nnerBorder'#2#2#7'Caption'#6#5'Solve'#7'OnClick'#7#16'ButtonSolveClick'#8'T' + +'abOrder'#2#1#0#0#0 +]); diff --git a/applications/sudoku/sudokumain.pas b/applications/sudoku/sudokumain.pas new file mode 100644 index 000000000..3d4e714c4 --- /dev/null +++ b/applications/sudoku/sudokumain.pas @@ -0,0 +1,155 @@ +unit sudokumain; + +{ + *************************************************************************** + * Copyright (C) 2006 Matthijs Willemstein * + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids, + Buttons, StdCtrls, sudokutype; + +type + + { TForm1 } + + TForm1 = class(TForm) + ButtonSolve: TButton; + ButtonFill: TButton; + Label1: TLabel; + StringGrid1: TStringGrid; + procedure ButtonFillClick(Sender: TObject); + procedure ButtonSolveClick(Sender: TObject); + procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Integer; + aRect: TRect; aState: TGridDrawState); + procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: string); + private + { private declarations } + theValues: TValues; + procedure SolveSudoku; + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +// Voor delphi is de volgende regel noodzakelijk. Spatie tussen { en $ verwijderen +{ $R *.dfm } + +{ TForm1 } + +procedure TForm1.ButtonFillClick(Sender: TObject); +var + c, r: Integer; +begin + for c := 0 to pred(StringGrid1.ColCount) do + for r := 0 to pred(StringGrid1.RowCount) do + StringGrid1.Cells[c, r] := ''; + Include(StringGrid1.Options, goEditing); + StringGrid1.SetFocus; +end; + +procedure TForm1.ButtonSolveClick(Sender: TObject); +var + c, r: Integer; +begin + Exclude(StringGrid1.Options, goEditing); + SolveSudoku; + StringGrid1.Clean; + for c := 1 to 9 do begin + for r := 1 to 9 do begin + StringGrid1.Cells[c - 1, r - 1] := theValues[c, r]; + if StringGrid1.Cells[c - 1, r - 1] = '0' then + StringGrid1.Cells[c - 1, r - 1] := ' '; + end; + end; +end; + +procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Integer; + aRect: TRect; aState: TGridDrawState); +var + Kleur: Boolean; +begin + Kleur := False; + if Col in [0..2, 6..8] then begin + if Row in [0..2, 6..8] then begin + Kleur := True; + end; + end else begin + if Row in [3..5] then begin + Kleur := True; + end; + end; + if Kleur then begin + inc(aRect.Top, 1); + inc(aRect.Left, 1); + dec(aRect.Bottom, 1); + dec(aRect.Right, 1); + StringGrid1.Canvas.Brush.Color := clLtGray; + StringGrid1.Canvas.FillRect(aRect); +// Volgende regel is alleen in Delphi noodzakelijk. +// StringGrid1.Canvas.TextOut(aRect.Left, aRect.Top, StringGrid1.Cells[Col, Row]); + end; +end; + +procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: string); +begin + if (Length(Value) >= 1) and (Value[1] in ['1'..'9']) then begin + theValues[ACol + 1, ARow + 1] := Value[1]; + end else begin + theValues[ACol + 1, ARow + 1] := ' '; + end; +end; + +procedure TForm1.SolveSudoku; +var + aSudoku: TSudoku; + c, r: Integer; + Stappen: Integer; +begin + for c := 0 to 8 do begin + for r := 0 to 8 do begin + if Length(StringGrid1.Cells[c, r]) >= 1 then begin + theValues[c + 1, r + 1] := StringGrid1.Cells[c, r][1]; + end else begin + theValues[c + 1, r + 1] := ' '; + end; + end; + end; + aSudoku := TSudoku.Create; + Stappen := aSudoku.GiveSolution(theValues); + aSudoku.Free; + ShowMessage('Sudoku solved in ' + IntToStr(Stappen) + ' steps.'); +end; + +initialization +// Voor lazarus is deze regel nodig. + {$I sudokumain.lrs} +end. + diff --git a/applications/sudoku/sudokutype.pas b/applications/sudoku/sudokutype.pas new file mode 100644 index 000000000..fd49e68a0 --- /dev/null +++ b/applications/sudoku/sudokutype.pas @@ -0,0 +1,239 @@ +unit sudokutype; + +{ + *************************************************************************** + * Copyright (C) 2006 Matthijs Willemstein * + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, StdCtrls; + +type + Digits = set of 1..9; + TSquare = record + Value: Char; // The value of this square. + Locked: Boolean; // Wether or not the value is known. + DigitsPossible: Digits; + end; + TValues = Array[1..9,1..9] of char; + + { TSudoku } + + TSudoku = class(TObject) + function GiveSolution(var Values: TValues): Integer; + private + Grid : Array[1..9, 1..9] of TSquare; + Steps: Integer; + procedure CalculateValues; + procedure CheckRow(c, r: Integer); + procedure CheckCol(c, r: Integer); + procedure CheckBlock(c, r: Integer); + procedure CheckDigits(d: Integer); + procedure Fill(Values: TValues); + procedure Solve; + function Solved: Boolean; + end; + +implementation + +const + cmin : Array[1..9] of Integer = (1, 1, 1, 4, 4, 4, 7, 7, 7); + cmax : Array[1..9] of Integer = (3, 3, 3, 6, 6, 6, 9, 9, 9); + +function CountSetMembers(const ASet: Digits; var aValue: Integer): Integer; +var + D: Integer; +begin + Result := 0; + for D := 1 to 9 do begin + if D in ASet then begin + Inc(Result); + aValue := D; + end; + end; +end; + +{ TSudoku } + +procedure TSudoku.Fill(Values: TValues); +var + c, r: Integer; +begin + for c := 1 to 9 do begin + for r := 1 to 9 do begin + if Values[c, r] in ['1'..'9'] then begin + Grid[c, r].Locked := True; + Grid[c, r].Value := Values[c, r]; + Grid[c, r].DigitsPossible := [StrToInt(Values[c, r])]; + end else begin + Grid[c, r].Locked := False; + Grid[c, r].Value := '0'; + Grid[c, r].DigitsPossible := [1, 2, 3, 4, 5, 6, 7, 8, 9]; + end; + end; + end; +end; + +procedure TSudoku.Solve; +var + c, r: Integer; +begin + Steps := 0; + repeat + inc(Steps); + for c := 1 to 9 do begin + for r := 1 to 9 do begin + if not Grid[c, r].Locked then begin + CheckRow(c, r); + CheckCol(c, r); + CheckBlock(c, r); + end; + end; + end; + for c := 1 to 9 do CheckDigits(c); + CalculateValues; + until Solved or (Steps > 50); +end; + +function TSudoku.GiveSolution(var Values: TValues): Integer; +var + c, r: Integer; +begin + Fill(Values); + Solve; + for c := 1 to 9 do begin + for r := 1 to 9 do begin + Values[c, r] := Grid[c, r].Value; + end; + end; + Result := Steps; +end; + +procedure TSudoku.CalculateValues; +var + c, r, d: Integer; + Value: Integer; +begin + for c := 1 to 9 do begin + for r := 1 to 9 do begin + if Grid[c, r].Locked then Continue; + if CountSetMembers(Grid[c, r].DigitsPossible, Value) = 1 then begin + Grid[c, r].Value := IntToStr(Value)[1]; + Grid[c, r].Locked := True; + end; + end; + end; +end; + +procedure TSudoku.CheckCol(c, r: Integer); +var + i, d: Integer; +begin + for i := 1 to 9 do begin + if i = r then continue; + for d := 1 to 9 do begin + if StrToInt(Grid[c, i].Value) = d then exclude(Grid[c, r].DigitsPossible, d); + end; + end; +end; + +procedure TSudoku.CheckRow(c, r: Integer); +var + i, d: Integer; +begin + for i := 1 to 9 do begin + if i = c then continue; + for d := 1 to 9 do begin + if StrToInt(Grid[i, r].Value) = d then exclude(Grid[c, r].DigitsPossible, d); + end; + end; +end; + +procedure TSudoku.CheckBlock(c, r: Integer); +var + i, j, d: Integer; +begin + for i := cmin[c] to cmax[c] do begin + for j := cmin[r] to cmax[r] do begin + if not ((i = c) and (j = r)) then begin + for d := 1 to 9 do begin + if StrToInt(Grid[i, j].Value) = d then exclude(Grid[c, r].DigitsPossible, d); + end; + end; + end; + end; +end; + +procedure TSudoku.CheckDigits(d: Integer); +var + OtherPossible: Boolean; + c, r: Integer; + i: Integer; + value: Integer; +begin + for c := 1 to 9 do begin + for r := 1 to 9 do begin + if Grid[c, r].Locked + or (CountSetMembers(Grid[c, r].DigitsPossible, Value) = 1) then continue; + if d in Grid[c, r].DigitsPossible then begin + OtherPossible := False; + for i := 1 to 9 do begin + if i <> c then OtherPossible := (d in Grid[i, r].DigitsPossible); + if OtherPossible then Break; + end; + if not OtherPossible then begin + Grid[c, r].DigitsPossible := [d]; + end else begin + OtherPossible := False; + for i := 1 to 9 do begin + if i <> r then OtherPossible := (d in Grid[c, i].DigitsPossible); + if OtherPossible then Break; + end; + if not OtherPossible then begin + Grid[c, r].DigitsPossible := [d]; + end; + end; + end; + end; + end; +end; + +function TSudoku.Solved: Boolean; +var + c, r: Integer; +begin + result := True; + for c := 1 to 9 do begin + for r := 1 to 9 do begin + if not Grid[c, r].Locked then begin + Result := False; + Break; + end; + end; + if not result then Break; + end; +end; + +end. +