Data update

This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions

108
Task/Sudoku/Ada/sudoku.adb Normal file
View file

@ -0,0 +1,108 @@
with Ada.Text_IO;
procedure Sudoku is
type sudoku_ar_t is array ( integer range 0..80 ) of integer range 0..9;
FINISH_EXCEPTION : exception;
procedure prettyprint(sudoku_ar: sudoku_ar_t);
function checkValidity( val : integer; x : integer; y : integer; sudoku_ar: in sudoku_ar_t) return Boolean;
procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t);
procedure solve(sudoku_ar: in out sudoku_ar_t);
function checkValidity( val : integer; x : integer; y : integer; sudoku_ar: in sudoku_ar_t) return Boolean
is
begin
for i in 0..8 loop
if ( sudoku_ar( y * 9 + i ) = val or sudoku_ar( i * 9 + x ) = val ) then
return False;
end if;
end loop;
declare
startX : constant integer := ( x / 3 ) * 3;
startY : constant integer := ( y / 3 ) * 3;
begin
for i in startY..startY+2 loop
for j in startX..startX+2 loop
if ( sudoku_ar( i * 9 +j ) = val ) then
return False;
end if;
end loop;
end loop;
return True;
end;
end checkValidity;
procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t)
is
begin
if ( pos = 81 ) then
raise FINISH_EXCEPTION;
end if;
if ( sudoku_ar(pos) > 0 ) then
placeNumber(pos+1, sudoku_ar);
return;
end if;
for n in 1..9 loop
if( checkValidity( n, pos mod 9, pos / 9 , sudoku_ar ) ) then
sudoku_ar(pos) := n;
placeNumber(pos + 1, sudoku_ar );
sudoku_ar(pos) := 0;
end if;
end loop;
end placeNumber;
procedure solve(sudoku_ar: in out sudoku_ar_t)
is
begin
placeNumber( 0, sudoku_ar );
Ada.Text_IO.Put_Line("Unresolvable !");
exception
when FINISH_EXCEPTION =>
Ada.Text_IO.Put_Line("Finished !");
prettyprint(sudoku_ar);
end solve;
procedure prettyprint(sudoku_ar: sudoku_ar_t)
is
line_sep : constant String := "------+------+------";
begin
for i in sudoku_ar'Range loop
Ada.Text_IO.Put(sudoku_ar(i)'Image);
if (i+1) mod 3 = 0 and not((i+1) mod 9 = 0) then
Ada.Text_IO.Put("|");
end if;
if (i+1) mod 9 = 0 then
Ada.Text_IO.Put_Line("");
end if;
if (i+1) mod 27 = 0 then
Ada.Text_IO.Put_Line(line_sep);
end if;
end loop;
end prettyprint;
sudoku_ar : sudoku_ar_t :=
(
8,5,0,0,0,2,4,0,0,
7,2,0,0,0,0,0,0,9,
0,0,4,0,0,0,0,0,0,
0,0,0,1,0,7,0,0,2,
3,0,5,0,0,0,9,0,0,
0,4,0,0,0,0,0,0,0,
0,0,0,0,8,0,0,7,0,
0,1,7,0,0,0,0,0,0,
0,0,0,0,3,6,0,4,0
);
begin
solve( sudoku_ar );
end Sudoku;

View file

@ -0,0 +1,85 @@
local buffer = require "pluto:buffer"
class sudoku
private grid, solved
-- Use 0-based indexing for the grid.
function __construct(rows)
if #rows != 9 or !rows:checkall(|r| -> #r == 9) then
error("Grid must be 9 x 9")
end
self.grid = {}
for i = 0, 8 do
for j = 0, 8 do self.grid[9 * i + j] = rows[i + 1][j + 1] end
end
self.solved = false
end
private function check_validity(v, x, y)
for i = 0, 8 do
if self.grid[y * 9 + i] == v or self.grid[i * 9 + x] == v then
return false
end
end
local start_x = (x // 3) * 3
local start_y = (y // 3) * 3
for i = start_y, start_y + 2 do
for j = start_x, start_x + 2 do
if self.grid[i * 9 + j] == v then return false end
end
end
return true
end
private function place_number(pos)
if self.solved then return end
if pos == 81 then
self.solved = true
return
end
if self.grid[pos] > "0" then
self:place_number(pos + 1)
return
end
for n = 1, 9 do
if self:check_validity(tostring(n), pos % 9, pos // 9) do
self.grid[pos] = tostring(n)
self:place_number(pos + 1)
if self.solved then return end
self.grid[pos] = "0"
end
end
end
function solve()
print($"Starting grid:\n\n{self}")
self:place_number(0)
print(self.solved ? $"Solution:\n\n{self}" : "Unsolvable!")
end
function __tostring()
local sb = new buffer()
for i = 0, 8 do
for j = 0, 8 do
sb:append(self.grid[i * 9 + j] .. " ")
if j == 2 or j == 5 then sb:append("| ") end
end
sb:append("\n")
if i == 2 or i == 5 then sb:append("------+-------+------\n") end
end
return sb:tostring()
end
end
local rows = {
"850002400",
"720000009",
"004000000",
"000107002",
"305000900",
"040000000",
"000080070",
"017000000",
"000036040"
}
new sudoku(rows):solve()

View file

@ -0,0 +1,92 @@
#width = 9 \ number of columns or lines (do not change, for clarity)
\ Find solution (recursive)
solve (cells):
cells.checks =+ 1 \ count checks
for pt =: row cells give keys \ find free cell
if cells[pt] ~= 0
continue
for k =: from 1 upto 9 \ all values at this point
if check k at pt in cells
cells[pt] =: k \ ok, set point
if solve cells
return #true \ cells has last state
cells[pt] =: 0 \ failed, clear
return #false
\ no free cells left: found, start raveling up the call stack
return #true
\ check if new value (val) at (pt) would conflict with row, column and squares
\ cell at (pt) must be still void
check (val) at (pt) in (cells):
x, y =: pt//#width, pt%%#width
\ scan rows and columns
for i =: from 0 upto 8
if val = cells[x*#width + i]
return #false
if val = cells[i*#width + y]
return #false
\ scan 3x3 square
x0 =: x - x %% 3
y0 =: y - y %% 3
for i =: from x0 upto x0+2
for j =: from y0 upto y0+2
if val = cells[i*#width + j]
return #false
return #true
\( Main program
\)
main (parms):+
cells =: create cells file parms[1]
grid cells print
if solve cells
grid cells print \ show result
print 'Found after', cells.checks, 'trials'
|
print "No solution found,", cells.checks, "rounds"
\ print the grid
grid (cells) print:
for i =: row cells give keys
c =: cells[i]
if c = () || c = 0
c =: '.'
print c _ ' ' nonl
if i %% 3 = 2
print ' ' nonl
if i %% #width = #width - 1
print ''
if i %% (3*#width) = 3*#width - 1
print ''
\( Input should be readable or from file
\)
default grid:
defpz =: '... ... ..6'
defpz =_ '.8. 12. .97'
defpz =_ '7.. 85. 1..'
defpz =_ '3.8 4.. ..9'
defpz =_ '.7. 3.2 .5.'
defpz =_ '2.. ..5 8.1'
defpz =_ '..7 .19 ..5'
defpz =_ '41. .78 .2.'
defpz =_ '5.. ... ...'
:> defpz
create cells file (fn):
input =: default grid
if fn ~= ()
input =: join file fn lines \ whole file as string
rv =: new row
ri =: 0 \ next to be set
for c =: string input give characters
? c = '.'
c =: '0'
? is c in '1234567890'
rv[ri] =: string c as integer
ri =+ 1
! rv.Count = #width^2: print rv.Count
:> rv

View file

@ -0,0 +1,152 @@
#width = 9 \ no of columns and lines, avoid literal numbers
\(
Find solution
\)
solve (cells):
\ if there are free cells left, try them:
while cells.count < #width^2
\ get point (pt) with smallest number of candidates (vals)
pt, vals =: grid (cells) calc next
if pt = ()
return #false
for k =: tuple vals give values
cells[pt] =: k \ set the point (pt) and try value (k)
if solve cells
:> #true
cells[pt] =: ()
cells.backtracks =+ 1
\ caller must retry
:> #false
\ all filled, this is a solution
:> #true
\( provide a point with the minimal number of choices,
and the choices for this point as tuple.
\)
grid (cells) calc next:
max =: #width + 1
for pt =: from 0 upto #width^2 - 1
? cells[pt] ~= () \ not free
continue
vals =: choices cells at pt
\ determine minimal number of choices
if vals.Count < max
max =: vals.Count
res =: pt, vals \ point and tuple of choices
:> res \ void if none found
\( calculate the choices at (pt)
use a row with 9 elements, initially set not void.
set void each elements that is found in same row, column or box
return a tuple of the choices (void if none)
\)
choices (cells) at (pt):
set =: new row size #width set 1
x, y =: pt // #width, pt %% #width \ integer quotient and remainder
\ scan rows and columns
for i =: from 0 upto 8
v =: cells[x*#width + i]
if v ~= ()
set[v] =: ()
v =: cells[i*#width + y]
if v~= ()
set[v] =: ()
\ scan 3x3 square
x0 =: x - x %% 3
y0 =: y - y %% 3
for i =: from x0 upto x0+2
for j =: from y0 upto y0+2
v =: cells[i*#width + j]
if v ~= ()
set[v] = ()
\ return a tuple of choices for better handling
rv =: new row
for k =: row set give keys \ ony not void element keys
rv[] =: k
return rv::as tuple
\( Main program
\)
main (parms):+
\ read puzzle either from file given, or use default
print "Input: " nonl
if parms[1] = ()
print "(internal default)"
else
print parms[1]
\ read the puzzle and show
cells =: new grid from parms[1] else simple default puzzle
grid cells print
if cells.set ~= #width^2
print "Input size not 81: ", cells.set, cells.init
print "cells to set:", 81 - cells.Count
cells.backtracks =: 0
\ find the solution
if solve cells
print "Found, retries:", cells.backtracks
print format "Time: %5.3f; sec" system cpu seconds
|
print "No solution found, remain:", 81 - cells.Count
grid cells print
\( print the grid
\)
grid (cells) print:
for i =: from 0 upto #width^2 - 1
if i %% 9 = 0:
print ''
\~ print format '%2;: ' i nonl
c =: cells[i]
if c = ()
c =: '.'
print c _ ' ' nonl
if i %% 3 = 2
print ' ' nonl
if i %% (3*#width) = 3*#width - 1
print ''
print ''
\( Create grid from file (fn) or string (init)
If the filename is a single minus, read standard input
All characters except 1 to 9 and a dot or 0 are ignored,
the dot (or 0) indicates a free field
\)
new grid from (fn) else (init):
\ input a (long) string from file
if fn ~= ()
if fn = '-': fn =: ()
init =: join file fn lines by ' '
\ create grid
cells =: new row size #width^2
cells.init =: init
ci =: 0 \ next to be set
for c =: string init give characters
? ~ is c in '1234567890.'
continue
? is c in '123456789'
cells[ci] =: string c as integer
ci =+ 1
cells.set =: ci
\ ready
return cells
simple default puzzle:
defpz =: '... ... ..6 '
defpz =_ '.8. 12. .97 '
defpz =_ '7.. 85. 1.. '
defpz =_ '3.8 4.. ..9 '
defpz =_ '.7. 3.2 .5. '
defpz =_ '2.. ..5 8.1 '
defpz =_ '..7 .19 ..5 '
defpz =_ '41. .78 .2. '
defpz =_ '5.. ... ...'
.> defpz

View file

@ -0,0 +1,80 @@
const grid_size = 9
fn is_number_in_row(board [][]int, number int, row int) bool {
for cell in board[row] {
if cell == number { return true }
}
return false
}
fn is_number_in_column(board [][]int, number int, column int) bool {
for row in board {
if row[column] == number { return true }
}
return false
}
fn is_number_in_box(board [][]int, number int, row int, column int) bool {
local_box_row := row - row % 3
local_box_column := column - column % 3
for i := local_box_row; i < local_box_row + 3; i++ {
for j := local_box_column; j < local_box_column + 3; j++ {
if board[i][j] == number { return true }
}
}
return false
}
fn is_valid_placement(board [][]int, number int, row int, column int) bool {
return !is_number_in_row(board, number, row) &&
!is_number_in_column(board, number, column) &&
!is_number_in_box(board, number, row, column)
}
fn solve_board(mut board [][]int) bool {
for i, row in board {
for j, cell in row {
if cell == 0 {
for n := 1; n <= grid_size; n++ {
if is_valid_placement(board, n, i, j) {
board[i][j] = n
if solve_board(mut board) { return true }
else { board[i][j] = 0 }
}
}
return false
}
}
}
return true
}
fn print_board(board [][]int) {
for i, row in board {
for j, cell in row {
print(cell.str())
if j == 2 || j == 5 { print("|") }
}
println("")
if i == 2 || i == 5 { println("-----------") }
}
println("")
}
fn main() {
mut board := [
[7, 0, 2, 0, 5, 0, 6, 0, 0],
[0, 0, 0, 0, 0, 3, 0, 0, 0],
[1, 0, 0, 0, 0, 9, 5, 0, 0],
[8, 0, 0, 0, 0, 0, 0, 9, 0],
[0, 4, 3, 0, 0, 0, 7, 5, 0],
[0, 9, 0, 0, 0, 0, 0, 0, 8],
[0, 0, 9, 7, 0, 0, 0, 0, 5],
[0, 0, 0, 2, 0, 0, 0, 0, 0],
[0, 0, 7, 0, 4, 0, 2, 0, 3],
]
print_board(board)
if solve_board(mut board) { print_board(board) }
}

View file

@ -0,0 +1,102 @@
Dim grid(9, 9)
Dim gridSolved(9, 9)
Public Sub Solve(i, j)
If i > 9 Then
'exit with gridSolved = Grid
For r = 1 To 9
For c = 1 To 9
gridSolved(r, c) = grid(r, c)
Next 'c
Next 'r
Exit Sub
End If
For n = 1 To 9
If isSafe(i, j, n) Then
nTmp = grid(i, j)
grid(i, j) = n
If j = 9 Then
Solve i + 1, 1
Else
Solve i, j + 1
End If
grid(i, j) = nTmp
End If
Next 'n
End Sub 'Solve
Public Function isSafe(i, j, n)
If grid(i, j) <> 0 Then
isSafe = (grid(i, j) = n)
Exit Function
End If
'grid(i,j) is an empty cell. Check if n is OK
'first check the row i
For c = 1 To 9
If grid(i, c) = n Then
isSafe = False
Exit Function
End If
Next 'c
'now check the column j
For r = 1 To 9
If grid(r, j) = n Then
isSafe = False
Exit Function
End If
Next 'r
'finally, check the 3x3 subsquare containing grid(i,j)
iMin = 1 + 3 * Int((i - 1) / 3)
jMin = 1 + 3 * Int((j - 1) / 3)
For r = iMin To iMin + 2
For c = jMin To jMin + 2
If grid(r, c) = n Then
isSafe = False
Exit Function
End If
Next 'c
Next 'r
'all tests were OK
isSafe = True
End Function 'isSafe
Public Sub Sudoku()
'main routine
Dim s(9)
s(1) = "001005070"
s(2) = "920600000"
s(3) = "008000600"
s(4) = "090020401"
s(5) = "000000000"
s(6) = "304080090"
s(7) = "007000300"
s(8) = "000007069"
s(9) = "010800700"
For i = 1 To 9
For j = 1 To 9
grid(i, j) = Int(Mid(s(i), j, 1))
Next 'j
Next 'j
'print problem
Wscript.echo "Problem:"
For i = 1 To 9
c=""
For j = 1 To 9
c=c & grid(i, j) & " "
Next 'j
Wscript.echo c
Next 'i
'solve it!
Solve 1, 1
'print solution
Wscript.echo "Solution:"
For i = 1 To 9
c=""
For j = 1 To 9
c=c & gridSolved(i, j) & " "
Next 'j
Wscript.echo c
Next 'i
End Sub 'Sudoku
Call sudoku

View file

@ -0,0 +1,117 @@
'VBScript Sudoku solver. Fast recursive algorithm adapted from the C version
'It can read a problem passed in the command line or from a file /f:textfile
'if no problem passed it solves a hardwired problem (See the prob0 string)
'problem string can have 0's or dots in the place of unknown values. All chars different from .0123456789 are ignored
Option explicit
Sub print(s):
On Error Resume Next
WScript.stdout.Write (s)
If err= &h80070006& Then WScript.Echo " Please run this script with CScript": WScript.quit
End Sub
function parseprob(s)'problem string to array
Dim i,j,m
print "parsing: " & s & vbCrLf & vbcrlf
j=0
For i=1 To Len(s)
m=Mid(s,i,1)
Select Case m
Case "0","1","2","3","4","5","6","7","8","9"
sdku(j)=cint(m)
j=j+1
Case "."
sdku(j)=0
j=j+1
Case Else 'all other chars are ignored as separators
End Select
Next
' print j
If j<>81 Then parseprob=false Else parseprob=True
End function
sub getprob 'get problem from file or from command line or from
Dim s,s1
With WScript.Arguments.Named
If .exists("f") Then
s1=.item("f")
If InStr(s1,"\")=0 Then s1= Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))&s1
On Error Resume Next
s= CreateObject("Scripting.FileSystemObject").OpenTextFile (s1, 1).readall
If err Then print "can't open file " & s1 : parseprob(prob0): Exit sub
If parseprob(s) =True Then Exit sub
End if
End With
With WScript.Arguments.Unnamed
If .count<>0 Then
s1=.Item(0)
If parseprob(s1)=True Then exit sub
End if
End With
parseprob(prob0)
End sub
function solve(x,ByVal pos)
'print pos & vbcrlf
'display(x)
Dim row,col,i,j,used
solve=False
If pos=81 Then solve= true :Exit function
row= pos\9
col=pos mod 9
If x(pos) Then solve=solve(x,pos+1):Exit Function
used=0
For i=0 To 8
used=used Or pwr(x(i * 9 + col))
Next
For i=0 To 8
used=used Or pwr(x(row*9 + i))
next
row = (row\ 3) * 3
col = (col \3) * 3
For i=row To row+2
For j=col To col+2
' print i & " " & j &vbcrlf
used = used Or pwr(x(i*9+j))
Next
Next
'print pos & " " & Hex(used) & vbcrlf
For i=1 To 9
If (used And pwr(i))=0 Then
x(pos)=i
'print pos & " " & i & " " & num2bin((used)) & vbcrlf
solve= solve(x,pos+1)
If solve=True Then Exit Function
'x(pos)=0
End If
Next
x(pos)=0
solve=False
End Function
Sub display(x)
Dim i,s
For i=0 To 80
If i mod 9=0 Then print s & vbCrLf :s=""
If i mod 27=0 Then print vbCrLf
If i mod 3=0 Then s=s & " "
s=s& x(i)& " "
Next
print s & vbCrLf
End Sub
Dim pwr:pwr=Array(1,2,4,8,16,32,64,128,256,512,1024,2048)
Dim prob0:prob0= "001005070"&"920600000"& "008000600"&"090020401"& "000000000" & "304080090" & "007000300" & "000007069" & "010800700"
Dim sdku(81),Time
getprob
print "The problem"
display(sdku)
Time=Timer
If solve (sdku,0) Then
print vbcrlf &"solution found" & vbcrlf
display(sdku)
Else
print "no solution found " & vbcrlf
End if
print vbcrlf & "time: " & Timer-Time & " seconds" & vbcrlf