aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Task/Sudoku/11l/sudoku.11l
View file

@ -4,8 +4,8 @@ T Sudoku
F (rows)
assert(rows.len == 9 & all(rows.map(row -> row.len == 9)), ‘Grid must be 9 x 9’)
L(i) 9
L(j) 9
L(i) 0.<9
L(j) 0.<9
.grid[9 * i + j] = Int(rows[i][j])
F solve()
@ -33,7 +33,7 @@ T Sudoku
.grid[pos] = 0
F checkValidity(v, x, y)
L(i) 9
L(i) 0.<9
I .grid[y * 9 + i] == v |
.grid[i * 9 + x] == v
R 0B
@ -49,8 +49,8 @@ T Sudoku
F String()
V s = ‘’
L(i) 9
L(j) 9
L(i) 0.<9
L(j) 0.<9
s ‘’= .grid[i * 9 + j]‘ ’
I j C (2, 5)
s ‘’= ‘| ’

108
Task/Sudoku/Ada/sudoku.ada
View file

@ -1,108 +0,0 @@
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;

20
Task/Sudoku/EasyLang/sudoku.easy
View file

@ -7,9 +7,7 @@ proc init .
for pos = 1 to 81
if pos mod 9 = 1
s$ = input
if s$ = ""
s$ = input
.
if s$ = "" : s$ = input
len inp[] 0
for i = 1 to len s$
if substr s$ i 1 <> " "
@ -34,22 +32,14 @@ init
proc display .
for i = 1 to 81
write grid[i] & " "
if i mod 3 = 0
write " "
.
if i mod 9 = 0
print ""
.
if i mod 27 = 0
print ""
.
if i mod 3 = 0 : write " "
if i mod 9 = 0 : print ""
if i mod 27 = 0 : print ""
.
.
#
proc solve pos .
while grid[pos] <> 0
pos += 1
.
while grid[pos] <> 0 : pos += 1
if pos > 81
# solved
display

24
Task/Sudoku/Uiua/sudoku.uiua
View file

@ -1,5 +1,5 @@
# Solves Sudoku using brute force.
# Experimental!
# Solves Sudoku using built-in ''path'' function.
S ← [[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]
@ -9,18 +9,18 @@ S ← [[8 5 0 0 0 2 4 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]]
Ps ← ⊞⊟.⇡9
Boxes ← ↯∞_9_2 ⊡⊞⊂.0_3_6 ◫3_3Ps
Nines ← ⊂Boxes⊂⟜(⮌1_0)Ps # 27 lists of pos's: one per row, col, box.
IsIn ← ☇1▽:⟜≡(∊:)Nines ¤ # (pos) -> pos's of all peers for a pos.
Peers ← ⊞(IsIn ⊟).⇡9 # For each pos, the pos of every peer (by row, col, box)
Posns ← ⊞⊟.⇡9
Units ← ↯∞_9_2 ⊡⊞⊂.0_3_6 ⧈∘3_3Posns # rows, columns, and boxes.
Nines ← ⊂Units⊂⟜(⤸1_0)Posns # 27 lists of pos's: one per row, col, box.
IsIn ← ♭₂▽:⟜≡(˜∊:)Nines ¤ # (pos) -> pos's of all peers for a pos.
Peers ← ⊞(IsIn ⊟).⇡9 # For each pos, the pos of every peer (by row, col, box)
Free ← ▽:⟜(¬∊)+1⇡9◴▽⊸(>0)⊡⊡:Peers # Free values at pos (pos board) -> [n]
Free ← ▽:⟜(¬˜∊)+1⇡9◴▽⊸(>0)⊡⊡:Peers # Free values at pos (pos board) -> [n]
Next ← (
=/↧.≡(⧻Free) ⊙¤,,⊚=0. # Find most constrained pos.
Free,,⊙◌⊢▽⊙. # Get free values at pos.
≡(⍜⊡⋅∘)λBCa # Generate node for each.
⊢▽=/↧.◡≡(⧻Free)⊙¤⊚=0. # Find most constrained emptypos.
◠Free⊙°¤ # Get free values at pos.
≡(⍜⊡⋅∘)∩¤ # Generate next node using each.
)
End ← =0/+/+=0
astar(⍣Next⋅[]|0|End)S
↙¯1°□⊢⊙◌
⊣⊢path(⍣Next⋅[]|End)S

102
Task/Sudoku/VBScript/sudoku-1.vb
View file

@ -1,102 +0,0 @@
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

117
Task/Sudoku/VBScript/sudoku-2.vb
View file

@ -1,117 +0,0 @@
'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