Data update

This commit is contained in:
Ingy döt Net 2025-06-11 20:16:52 -04:00
parent 72eb4943cb
commit 4d5544505c
2347 changed files with 62432 additions and 16731 deletions

View file

@ -0,0 +1,3 @@
F {1+ / 2| +˝ 0= |˜ 1+𝕩}
F 100
# ⟨ 1 4 9 16 25 36 49 64 81 100 ⟩

View file

@ -0,0 +1,3 @@
F {ט1+𝕩}
F 100
# ⟨ 1 4 9 16 25 36 49 64 81 100 ⟩

View file

@ -7,7 +7,5 @@ for p = 1 to 100
.
.
for i = 1 to 100
if d[i] = 1
print i
.
if d[i] = 1 : write i & " "
.

View file

@ -14,8 +14,8 @@ public program()
for(int i := 0; i < 100; i++)
{
console.printLine("Door #",i + 1," :",Doors[i].iif("Open","Closed"))
Console.printLine("Door #",i + 1," :",Doors[i].iif("Open","Closed"))
};
console.readChar()
Console.readChar()
}

View file

@ -0,0 +1 @@
=LET(i, SEQUENCE(100), root, SQRT(i), "Door " & i & ": " & IF(root = INT(root), "open", "close"))

View file

@ -0,0 +1,32 @@
REM Author.....: Eva Broccoli
REM Date.......: 23 May 2025
REM Description: OPL solution for "100 doors" task on https://rosettacode.org
REM Tested with: Psion Series 3a & Series 5
REM Contact....: eva.klassen@kittymail.com
PROC main:
LOCAL door%(100),i%,j%
i%=1
j%=1
WHILE j%<101
WHILE i%<101
IF door%(i%)=0
door%(i%)=1
ELSE
door%(i%)=0
ENDIF
i%=i%+j%
ENDWH
j%=j%+1
i%=0+j%
ENDWH
PRINT "Open doors:",
i%=1
WHILE i%<101
IF door%(i%)=1
PRINT i%,
ENDIF
i%=i%+1
ENDWH
GET
ENDP

View file

@ -0,0 +1,17 @@
[ bit ^ ] is toggle ( f n --> f )
[ 0
100 times
[ i^ 1+ swap
101 times
[ i^ toggle over step ]
nip ] ] is toggledoors ( --> f )
[ 100 times
[ 1 >> dup 1 &
if [ i^ 1+ echo sp ] ]
drop ] is echodoors ( f --> )
toggledoors
say " These doors are open: " echodoors cr
say " The rest are closed." cr

View file

@ -0,0 +1 @@
10 times [ i^ 1+ 2 ** echo sp ]

View file

@ -1,22 +0,0 @@
/O> [ bit ^ ] is toggle ( f n --> f )
...
... [ 0
... 100 times
... [ i^ 1+ swap
... 101 times
... [ i^ toggle over step ]
... nip ] ] is toggledoors ( --> f )
...
... [ 100 times
... [ 1 >> dup 1 &
... if [ i^ 1+ echo sp ] ]
... drop ] is echodoors ( f --> )
...
... toggledoors
... say " These doors are open: " echodoors cr
... say " The rest are closed." cr
...
These doors are open: 1 4 9 16 25 36 49 64 81 100
The rest are closed.
Stack empty.

View file

@ -1,11 +1,85 @@
package require Tcl 8.5
set n 100
set doors [concat - [lrepeat $n 0]]
for {set step 1} {$step <= $n} {incr step} {
for {set i $step} {$i <= $n} {incr i $step} {
lset doors $i [expr { ! [lindex $doors $i]}]
#!/usr/bin/env tclsh
# 100 doors
proc seq { m n } {
set r {}
for {set i $m} {$i <= $n} {incr i} {
lappend r $i
}
return $r
}
proc toggle {val a b} {
# expr has ternary operators
return [expr {
${val} == ${a}? ${b} :
${val} == ${b}? ${a} :
[error "bad value: ${val}"]
}]
}
proc multiples {n max} {
set ret {}
set x $n
# maximum multiple
set mid [expr $max / 2]
if {$x>=$mid && $x<$max} { return $x }
# calculate multiples
if {[expr $x <= $mid]} {
for {set i 1} {$i <= $max } {incr i} {
set x [expr $i * $n]
if {$x > $max} { break }
lappend ret $x
}
}
return $ret
}
# states
array set state {
open "open"
closed "closed"
unknown "?"
}
# ==============================
# start program
# 100 doors
variable MAX 100
variable mid [expr int($MAX / 2)]
variable Seq_100 [seq 1 $MAX]
# initialize doors closed
foreach n $Seq_100 {
set door($n) $state(closed)
}
# do for 1 .. 100
foreach m $Seq_100 {
set mults [multiples $m $MAX]
foreach d $mults {
set door($d) [toggle $door($d) $state(open) $state(closed)]
}
}
for {set i 1} {$i <= $n} {incr i} {
puts [format "door %d is %s" $i [expr {[lindex $doors $i] ? "open" : "closed"}]]
# output
foreach n $Seq_100 {
if { $door($n) eq $state(open) } {
puts stdout "$n: $door($n)"
}
}
# end

View file

@ -1,8 +1,11 @@
package require Tcl 8.5
set doors [lrepeat [expr {$n + 1}] closed]
for {set i 1} {$i <= sqrt($n)} {incr i} {
lset doors [expr {$i ** 2}] open
set n 100
set doors [concat - [lrepeat $n 0]]
for {set step 1} {$step <= $n} {incr step} {
for {set i $step} {$i <= $n} {incr i $step} {
lset doors $i [expr { ! [lindex $doors $i]}]
}
}
for {set i 1} {$i <= $n} {incr i} {
puts [format "door %d is %s" $i [lindex $doors $i]]
puts [format "door %d is %s" $i [expr {[lindex $doors $i] ? "open" : "closed"}]]
}

View file

@ -1,46 +1,8 @@
package require Tcl 8.5
package require Tk
array set door_status {}
# create the gui
set doors [list x]
for {set i 0} {$i < 10} {incr i} {
for {set j 0} {$j < 10} {incr j} {
set k [expr {1 + $j + 10*$i}]
lappend doors [radiobutton .d_$k -text $k -variable door_status($k) \
-indicatoron no -offrelief flat -width 3 -value open]
grid [lindex $doors $k] -column $j -row $i
}
set doors [lrepeat [expr {$n + 1}] closed]
for {set i 1} {$i <= sqrt($n)} {incr i} {
lset doors [expr {$i ** 2}] open
}
# create the controls
button .start -command go -text Start
label .i_label -text " door:"
entry .i -textvariable i -width 4
label .step_label -text " step:"
entry .step -textvariable step -width 4
grid .start - .i_label - .i - .step_label - .step - -row $i
grid configure .start -sticky ew
grid configure .i_label .step_label -sticky e
grid configure .i .step -sticky w
proc go {} {
global doors door_status i step
# initialize the door_status (all closed)
for {set d 1} {$d <= 100} {incr d} {
set door_status($d) closed
}
# now, begin opening and closing
for {set step 1} {$step <= 100} {incr step} {
for {set i 1} {$i <= 100} {incr i} {
if {$i % $step == 0} {
[lindex $doors $i] [expr {$door_status($i) eq "open" ? "deselect" : "select"}]
update
after 50
}
}
}
for {set i 1} {$i <= $n} {incr i} {
puts [format "door %d is %s" $i [lindex $doors $i]]
}

View file

@ -0,0 +1,46 @@
package require Tcl 8.5
package require Tk
array set door_status {}
# create the gui
set doors [list x]
for {set i 0} {$i < 10} {incr i} {
for {set j 0} {$j < 10} {incr j} {
set k [expr {1 + $j + 10*$i}]
lappend doors [radiobutton .d_$k -text $k -variable door_status($k) \
-indicatoron no -offrelief flat -width 3 -value open]
grid [lindex $doors $k] -column $j -row $i
}
}
# create the controls
button .start -command go -text Start
label .i_label -text " door:"
entry .i -textvariable i -width 4
label .step_label -text " step:"
entry .step -textvariable step -width 4
grid .start - .i_label - .i - .step_label - .step - -row $i
grid configure .start -sticky ew
grid configure .i_label .step_label -sticky e
grid configure .i .step -sticky w
proc go {} {
global doors door_status i step
# initialize the door_status (all closed)
for {set d 1} {$d <= 100} {incr d} {
set door_status($d) closed
}
# now, begin opening and closing
for {set step 1} {$step <= 100} {incr step} {
for {set i 1} {$i <= 100} {incr i} {
if {$i % $step == 0} {
[lindex $doors $i] [expr {$door_status($i) eq "open" ? "deselect" : "select"}]
update
after 50
}
}
}
}

View file

@ -1,60 +1,51 @@
for i = 1 to 100
drawer[] &= i
sampler[] &= i
global drawer[] sampler[] .
proc init .
for i = 1 to 100
drawer[] &= i
sampler[] &= i
.
.
subr shuffle_drawer
init
proc shuffle_drawer .
for i = len drawer[] downto 2
r = random i
swap drawer[r] drawer[i]
.
.
subr play_random
func play_random .
shuffle_drawer
for prisoner = 1 to 100
found = 0
for i = 1 to 50
r = random (100 - i)
r = random (100 - i + 1)
card = drawer[sampler[r]]
swap sampler[r] sampler[100 - i - 1]
if card = prisoner
found = 1
break 1
.
.
if found = 0
break 1
swap sampler[r] sampler[100 - i + 1]
if card = prisoner : break 1
.
if i > 50 : return 0
.
return 1
.
subr play_optimal
func play_optimal .
shuffle_drawer
for prisoner = 1 to 100
reveal = prisoner
found = 0
for i = 1 to 50
card = drawer[reveal]
if card = prisoner
found = 1
break 1
.
if card = prisoner : break 1
reveal = card
.
if found = 0
break 1
.
if i > 50 : return 0
.
return 1
.
n = 10000
win = 0
for _ = 1 to n
play_random
win += found
n = 100000
for i to n
win += play_random
.
print "random: " & 100.0 * win / n & "%"
#
win = 0
for _ = 1 to n
play_optimal
win += found
for i to n
win += play_optimal
.
print "optimal: " & 100.0 * win / n & "%"

View file

@ -1,47 +1,38 @@
sysconf topleft
background 432
textsize 13
gbackground 432
gtextsize 13
len f[] 16
proc draw . .
clear
proc draw .
gclear
for i = 1 to 16
h = f[i]
if h < 16
v = f[i]
if v < 16
x = (i - 1) mod 4 * 24 + 3
y = (i - 1) div 4 * 24 + 3
color 210
move x y
rect 22 22
move x + 4 y + 6
if h < 10
move x + 6 y + 6
.
color 885
text h
gcolor 210
grect x y 22 22
if v < 10 : x += 2
gcolor 885
gtext x + 4 y + 6 v
.
.
.
global done .
proc smiley . .
proc smiley .
s = 3.5
x = 86
y = 86
move x y
color 983
circle 2.8 * s
color 000
move x - s y - s
circle s / 3
move x + 3.5 y - 3.5
circle s / 3
linewidth s / 3
curve [ x - s y + s x y + 2 * s x + s y + s ]
gcolor 983
gcircle x y 2.8 * s
gcolor 000
gcircle (x - s) (y - s) (s / 3)
gcircle x + 3.5 y - 3.5 s / 3
glinewidth s / 3
gcurve [ x - s y + s x y + 2 * s x + s y + s ]
.
proc init . .
global done .
proc init .
done = 0
for i = 1 to 16
f[i] = i
.
for i = 1 to 16 : f[i] = i
# shuffle
for i = 15 downto 2
r = random i
@ -49,20 +40,14 @@ proc init . .
.
# make it solvable
inv = 0
for i = 1 to 15
for j = 1 to i - 1
if f[j] > f[i]
inv += 1
.
.
for i = 1 to 15 : for j = 1 to i - 1
if f[j] > f[i] : inv += 1
.
if inv mod 2 <> 0
swap f[1] f[2]
.
textsize 12
if inv mod 2 <> 0 : swap f[1] f[2]
gtextsize 12
draw
.
proc move_tile . .
proc move_tile .
c = mouse_x div 25
r = mouse_y div 25
i = r * 4 + c + 1
@ -77,9 +62,7 @@ proc move_tile . .
.
draw
for i = 1 to 15
if f[i] > f[i + 1]
return
.
if f[i] > f[i + 1] : return
.
done = 1
timer 0.5
@ -87,7 +70,7 @@ proc move_tile . .
on mouse_down
if done = 0
move_tile
elif done = 3
elif done = 3 and mouse_x > 75 and mouse_y > 75
init
.
.

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,97 @@
class FifteenSolver {
constructor(n, g) {
this.Nr = [3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3];
this.Nc = [3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2];
this.n = 0;
this._n = 0;
this.N0 = new Array(100).fill(0);
this.N3 = new Array(100).fill('');
this.N4 = new Array(100).fill(0);
this.N2 = new Array(100).fill(0n);
this.N0[0] = n;
this.N2[0] = BigInt(g);
}
fY() {
if (this.N4[this.n] < this._n) return this.fN();
if (this.N2[this.n] === 0x123456789abcdef0n) {
let moves = '';
for (let g = 1; g <= this.n; g++) moves += this.N3[g];
console.log(`Solution found in ${this.n} moves: ${moves}`);
return true;
}
if (this.N4[this.n] === this._n) return this.fN();
return false;
}
fN() {
if (this.N3[this.n] !== 'u' && Math.floor(this.N0[this.n]/4) < 3) {
this.fI();
this.n++;
if (this.fY()) return true;
this.n--;
}
if (this.N3[this.n] !== 'd' && Math.floor(this.N0[this.n]/4) > 0) {
this.fG();
this.n++;
if (this.fY()) return true;
this.n--;
}
if (this.N3[this.n] !== 'l' && this.N0[this.n]%4 < 3) {
this.fE();
this.n++;
if (this.fY()) return true;
this.n--;
}
if (this.N3[this.n] !== 'r' && this.N0[this.n]%4 > 0) {
this.fL();
this.n++;
if (this.fY()) return true;
this.n--;
}
return false;
}
fI() {
const g = (11 - this.N0[this.n]) * 4;
const a = this.N2[this.n] & (15n << BigInt(g));
this.N0[this.n + 1] = this.N0[this.n] + 4;
this.N2[this.n + 1] = this.N2[this.n] - a + (a << 16n);
this.N3[this.n + 1] = 'd';
this.N4[this.n + 1] = this.N4[this.n] + (this.Nr[Number(a >> BigInt(g))] <= Math.floor(this.N0[this.n]/4) ? 0 : 1);
}
fG() {
const g = (19 - this.N0[this.n]) * 4;
const a = this.N2[this.n] & (15n << BigInt(g));
this.N0[this.n + 1] = this.N0[this.n] - 4;
this.N2[this.n + 1] = this.N2[this.n] - a + (a >> 16n);
this.N3[this.n + 1] = 'u';
this.N4[this.n + 1] = this.N4[this.n] + (this.Nr[Number(a >> BigInt(g))] >= Math.floor(this.N0[this.n]/4) ? 0 : 1);
}
fE() {
const g = (14 - this.N0[this.n]) * 4;
const a = this.N2[this.n] & (15n << BigInt(g));
this.N0[this.n + 1] = this.N0[this.n] + 1;
this.N2[this.n + 1] = this.N2[this.n] - a + (a << 4n);
this.N3[this.n + 1] = 'r';
this.N4[this.n + 1] = this.N4[this.n] + (this.Nc[Number(a >> BigInt(g))] <= this.N0[this.n]%4 ? 0 : 1);
}
fL() {
const g = (16 - this.N0[this.n]) * 4;
const a = this.N2[this.n] & (15n << BigInt(g));
this.N0[this.n + 1] = this.N0[this.n] - 1;
this.N2[this.n + 1] = this.N2[this.n] - a + (a >> 4n);
this.N3[this.n + 1] = 'l';
this.N4[this.n + 1] = this.N4[this.n] + (this.Nc[Number(a >> BigInt(g))] >= this.N0[this.n]%4 ? 0 : 1);
}
solve() {
while (!this.fY()) this._n++;
}
}
const start = new FifteenSolver(8, '0xfe169b4c0a73d852');
start.solve();

View file

@ -0,0 +1,178 @@
(* Constants for the correct ordering and board position mapping *)
correctOrder = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0};
rowOf = {0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3} + 1; (* +1 because Mathematica uses 1-based indexing *)
colOf = {0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3} + 1; (* +1 because Mathematica uses 1-based indexing *)
(* Function to estimate remaining moves using Manhattan distance *)
EstimateMoves[board_] := Module[{h = 0},
Do[
(* Skip the empty tile (0) *)
If[board[[i]] != 0,
(* Find where this tile should be in the correct order *)
correctPos = Position[correctOrder, board[[i]]][[1, 1]];
(* Calculate Manhattan distance: |current_row - correct_row| + |current_col - correct_col| *)
h += Abs[rowOf[[i]] - rowOf[[correctPos]]] + Abs[colOf[[i]] - colOf[[correctPos]]];
],
{i, 1, 16}
];
h
]
(* Find the position of the blank tile (0) *)
FindBlankPosition[board_] := Position[board, 0][[1, 1]]
(* Generate possible moves from current state *)
GenerateMoves[board_, movesSoFar_] := Module[
{blankPos, possibleMoves = {}, newBoard, newMoves},
blankPos = FindBlankPosition[board];
(* Check if we can move left (blank goes right) *)
If[Mod[blankPos, 4] != 1,
newBoard = board;
newBoard[[blankPos]] = newBoard[[blankPos - 1]];
newBoard[[blankPos - 1]] = 0;
newMoves = movesSoFar <> "r";
AppendTo[possibleMoves, {newBoard, newMoves, Length[newMoves] + EstimateMoves[newBoard]}];
];
(* Check if we can move right (blank goes left) *)
If[Mod[blankPos, 4] != 0,
newBoard = board;
newBoard[[blankPos]] = newBoard[[blankPos + 1]];
newBoard[[blankPos + 1]] = 0;
newMoves = movesSoFar <> "l";
AppendTo[possibleMoves, {newBoard, newMoves, Length[newMoves] + EstimateMoves[newBoard]}];
];
(* Check if we can move up (blank goes down) *)
If[blankPos > 4,
newBoard = board;
newBoard[[blankPos]] = newBoard[[blankPos - 4]];
newBoard[[blankPos - 4]] = 0;
newMoves = movesSoFar <> "d";
AppendTo[possibleMoves, {newBoard, newMoves, Length[newMoves] + EstimateMoves[newBoard]}];
];
(* Check if we can move down (blank goes up) *)
If[blankPos <= 12,
newBoard = board;
newBoard[[blankPos]] = newBoard[[blankPos + 4]];
newBoard[[blankPos + 4]] = 0;
newMoves = movesSoFar <> "u";
AppendTo[possibleMoves, {newBoard, newMoves, Length[newMoves] + EstimateMoves[newBoard]}];
];
possibleMoves
]
(* A* Search algorithm for solving the puzzle *)
Solve15Puzzle[startBoard_] := Module[
{openSet = {}, closedSet = {}, current, children, bestMoves = {}},
(* Initialize the priority queue (Mathematica doesn't have a built-in priority queue,
so we'll use a list and sort it each time) *)
openSet = {{startBoard, "", EstimateMoves[startBoard]}};
While[Length[openSet] > 0,
(* Sort the open set by total estimated cost *)
openSet = Sort[openSet, #1[[3]] < #2[[3]] &];
(* Get the most promising state *)
current = First[openSet];
openSet = Rest[openSet];
(* Check if we've reached the goal state *)
If[current[[1]] == correctOrder,
Print["Solution found!"];
Print["Moves: ", current[[2]]];
Print["Number of moves: ", StringLength[current[[2]]]];
Print["Open set size: ", Length[openSet]];
Print["Closed set size: ", Length[closedSet]];
(* Format the final board *)
Print["Final board:"];
Print[Partition[current[[1]], 4]];
Return[current[[2]]];
];
(* Generate all possible moves from current state *)
children = GenerateMoves[current[[1]], current[[2]]];
(* Process each child state *)
For[i = 1, i <= Length[children], i++,
child = children[[i]];
childBoard = child[[1]];
(* Check if this board is already in the closed set *)
If[Not[MemberQ[Map[First, closedSet], childBoard]],
(* Check if this board is already in the open set *)
existingIdx = Position[Map[First, openSet], childBoard];
If[existingIdx == {},
(* Add to open set if not already there *)
AppendTo[openSet, child];
,
(* Update if this path is better than existing one *)
existingIdx = existingIdx[[1, 1]];
If[StringLength[child[[2]]] < StringLength[openSet[[existingIdx, 2]]],
openSet[[existingIdx]] = child;
];
];
];
];
(* Add current state to closed set *)
AppendTo[closedSet, current];
];
Print["No solution found!"];
Return[{}];
]
(* Example usage *)
startingBoard = {15, 14, 1, 6, 9, 11, 4, 12, 0, 10, 7, 3, 13, 8, 5, 2};
(* startingBoard = {0, 1, 2, 3, 5, 6, 7, 4, 9, 10, 11, 8, 13, 14, 15, 12}; *)
solution = Solve15Puzzle[startingBoard];
(* Pretty print function to visualize a board *)
PrintBoard[board_] := Module[{},
Grid[Partition[board, 4], Frame -> All]
]
(* Visualization code to show the solution step by step *)
VisualizeSolution[startBoard_, moves_] := Module[
{currentBoard = startBoard, frames = {PrintBoard[startBoard]}, blankPos},
Do[
blankPos = FindBlankPosition[currentBoard];
Switch[StringTake[moves, {i}],
"l", (* blank moves left *)
currentBoard[[blankPos]] = currentBoard[[blankPos - 1]];
currentBoard[[blankPos - 1]] = 0,
"r", (* blank moves right *)
currentBoard[[blankPos]] = currentBoard[[blankPos + 1]];
currentBoard[[blankPos + 1]] = 0,
"u", (* blank moves up *)
currentBoard[[blankPos]] = currentBoard[[blankPos - 4]];
currentBoard[[blankPos - 4]] = 0,
"d", (* blank moves down *)
currentBoard[[blankPos]] = currentBoard[[blankPos + 4]];
currentBoard[[blankPos + 4]] = 0
];
AppendTo[frames, PrintBoard[currentBoard]];
,{i, 1, StringLength[moves]}
];
ListAnimate[frames]
]
(* Uncomment to visualize the solution *)
(* If[solution != {}, VisualizeSolution[startingBoard, solution]]; *)

View file

@ -0,0 +1,187 @@
const std = @import("std");
const Allocator = std.mem.Allocator;
const ArrayList = std.ArrayList;
const PriorityQueue = std.PriorityQueue;
const AutoHashMap = std.AutoHashMap;
// Constants for the puzzle
const CORRECT_ORDER = [16]u8{ 1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0 };
const ROW = [16]i32{ 0,0,0,0, 1,1,1,1, 2,2,2,2, 3,3,3,3 };
const COLUMN = [16]i32{ 0,1,2,3, 0,1,2,3, 0,1,2,3, 0,1,2,3 };
// State struct to represent the puzzle state
const State = struct {
est_tot_moves: u8,
moves: []u8,
est_moves_rem: u8,
allocator: Allocator,
pub fn init(allocator: Allocator, order: [16]u8) !State {
return State{
.est_tot_moves = estimate_moves(order),
.moves = try allocator.dupe(u8, ""), // empty
.est_moves_rem = estimate_moves(order),
.allocator = allocator,
};
}
pub fn deinit(self: *State) void {
self.allocator.free(self.moves);
}
};
// BoardState represents the entire game state
const BoardState = struct {
order: [16]u8,
state: State,
};
// Find the index of a tile in the order array
fn findIndex(order: [16]u8, tile: u8) usize {
var i: usize = 0;
for (order) |v| {
if (v == tile) return i;
i += 1;
}
@panic("findIndex: tile not found");
}
// Estimate the number of moves (Manhattan distance)
fn estimate_moves(current: [16]u8) u8 {
var h: u8 = 0;
for (current) |tile| {
const ci = findIndex(current, tile);
const gi = findIndex(CORRECT_ORDER, tile);
const rd = @abs(ROW[ci] - ROW[gi]);
const cd = @abs(COLUMN[ci] - COLUMN[gi]);
h += @as(u8, @intCast(rd + cd));
}
return h;
}
// Make a single move (swap hole with neighbor)
fn makeMove(
allocator: Allocator,
parent: *const State,
order: [16]u8,
dir: u8,
idx: usize,
new_idx: usize,
) !BoardState {
var new_order = order;
new_order[idx] = order[new_idx];
new_order[new_idx] = order[idx];
const rem = estimate_moves(new_order);
const mv: [1]u8 = .{dir};
const combined = try std.mem.concat(allocator, u8, &[_][]const u8{ parent.moves, &mv });
return BoardState{
.order = new_order,
.state = State{
.est_tot_moves = @as(u8, @intCast(combined.len)) + rem,
.moves = combined,
.est_moves_rem = rem,
.allocator = allocator,
},
};
}
// Generate all children from a parent (takes *const so we don't double-free)
fn generateChildren(allocator: Allocator, parent: *const BoardState) !ArrayList(BoardState) {
var children = ArrayList(BoardState).init(allocator);
const hole = findIndex(parent.order, 0);
if (COLUMN[hole] > 0) {
const c = try makeMove(allocator, &parent.state, parent.order, 'l', hole, hole - 1);
try children.append(c);
}
if (COLUMN[hole] < 3) {
const c = try makeMove(allocator, &parent.state, parent.order, 'r', hole, hole + 1);
try children.append(c);
}
if (ROW[hole] > 0) {
const c = try makeMove(allocator, &parent.state, parent.order, 'u', hole, hole - 4);
try children.append(c);
}
if (ROW[hole] < 3) {
const c = try makeMove(allocator, &parent.state, parent.order, 'd', hole, hole + 4);
try children.append(c);
}
return children;
}
// Compare function for priority queue
fn boardCompare(_: void, a: BoardState, b: BoardState) std.math.Order {
return std.math.order(a.state.est_tot_moves, b.state.est_tot_moves);
}
// Hash an order into a u64
fn hashOrder(order: [16]u8) u64 {
var r: u64 = 0;
for (order) |v| r = (r << 4) | v;
return r;
}
pub fn main() !void {
var gpa = std.heap.GeneralPurposeAllocator(.{}){};
defer _ = gpa.deinit();
const allocator = gpa.allocator();
var open_states = PriorityQueue(BoardState, void, boardCompare).init(allocator, {});
defer {
while (open_states.count() > 0) {
var item = open_states.remove();
item.state.deinit();
}
open_states.deinit();
}
var closed_states = AutoHashMap(u64, void).init(allocator);
defer closed_states.deinit();
const start_order = [16]u8{15,14,1,6,9,11,4,12, 0,10,7,3,13,8,5,2};
const initial_state = try State.init(allocator, start_order);
try open_states.add(BoardState{ .order = start_order, .state = initial_state });
const stdout = std.io.getStdOut().writer();
while (open_states.count() > 0) {
var current = open_states.remove();
// goal check
if (std.mem.eql(u8, &current.order, &CORRECT_ORDER)) {
try stdout.print(
"Open: {d}, Closed: {d}, Moves: {d}\n",
.{ open_states.count(), closed_states.count(), current.state.moves.len },
);
try stdout.print("Path: {s}\n", .{ current.state.moves });
current.state.deinit();
break;
}
const h = hashOrder(current.order);
if (closed_states.contains(h)) {
current.state.deinit();
continue;
}
try closed_states.put(h, {});
var children = try generateChildren(allocator, &current);
defer children.deinit();
// Heres the fix: shadow each child into a mutable `var child`
for (children.items) |child| {
var my_child = child; // now `child.state.deinit()` sees a `*State`, not `*const State`
const ch = hashOrder(my_child.order);
if (closed_states.contains(ch)) {
my_child.state.deinit();
continue;
}
try open_states.add(my_child);
}
current.state.deinit();
}
}

View file

@ -15,7 +15,7 @@ Spawn←{i←•rand.Range∘≠⊸⊑(0⊸= /○⥊ ↕∘≢)𝕩 ⋄ (•rand
LoseLeftRightDownUp # Losing condition, no moves change the board
Win´·˝2048= # Winning condition, 2048!
Quit{•Out e"[?12l"e"[?25h" •Exit 𝕩} # Restores the terminal and exits
Quit{•Out e"[?12l"e"[?25h" •term.RawMode 0 •Exit 𝕩} # Restores the terminal and exits
Display{ # Displays the board, score and controls
•Out e"[H"e"[2J" # Cursor to origin and clear screen
•Out "Controls: h: left, j: down, k: up, l: right, q: quit"

View file

@ -0,0 +1,161 @@
len brd[] 16
gbackground 987
proc newtile .
for i to 16 : if brd[i] = 0 : break 1
if i > 16 : return
v = 2
if randomf < 0.1 : v = 4
repeat
ind = random 16
until brd[ind] = 0
.
brd[ind] = v
.
global pts stat .
proc show .
gclear
gtextsize 5
gcolor 222
gtext 10 94 "2048 Game"
gtext 60 94 "Pts: " & pts
gtextsize 7
gcolor 876
grect 9 9 82 82
gcolor 987
grect 10 10 80 80
for i to 16 : if brd[i] <> 0
x = i mod1 4 * 20 - 9.5
y = i div1 4 * 20 - 9.5
gcolor 765
grect x y 19 19
v = brd[i]
h = 2 * floor log10 v
gcolor 000
gtext x + 7 - h y + 7 brd[i]
.
.
proc init .
for i to 16 : brd[i] = 0
newtile
newtile
stat = 0
pts = 0
show
.
init
#
dir[] = [ -4 -1 4 1 ]
start[] = [ 16 4 1 13 ]
proc domove indk test &moved .
moved = 0
dir = dir[indk]
bdir = dir[(indk + 1) mod1 4]
start = start[indk]
for i to 4
h0 = start + dir
for j to 3
if brd[h0] <> 0
v = brd[h0]
h = h0
while h <> start and brd[h - dir] = 0 : h -= dir
if h <> h0
moved = 1
if test = 1 : return
.
if h <> start and brd[h - dir] = v
moved = 1
if test = 1 : return
v *= 2
pts += v
brd[h - dir] = -v
if v = 2048 : stat = 1
v = 0
.
brd[h0] = 0
brd[h] = v
.
h0 += dir
.
h0 = start
for j to 3
brd[h0] = abs brd[h0]
h0 += dir
.
sleep 0.1
show
start += bdir
.
.
proc handle indk .
if indk = 0 : return
domove indk 0 moved
if moved = 1
newtile
sleep 0.2
show
if stat = 0
stat = 2
for indk to 4
domove indk 1 moved
if moved = 1
stat = 0
break 1
.
.
.
.
if stat <> 0
gtextsize 5
if stat = 1
stat = 0
gtext 10 3 "You got 2048 😊"
else
gtext 10 3 "No more moves 🙁"
.
.
.
on mouse_down
mx = mouse_x
my = mouse_y
.
proc handle_mup .
dx = mouse_x - mx
dy = mouse_y - my
indk = 0
if abs dx > abs dy
if abs dx > 3
indk = 4
if dx > 0 : indk = 2
.
else
if abs dy > 3
indk = 3
if dy > 0 : indk = 1
.
.
if indk <> 0 and stat = 2
init
else
handle indk
.
.
on mouse_up
handle_mup
.
on key
if stat = 2
if keybkey = " " : init
return
.
indk = 0
if keybkey = "ArrowUp"
indk = 1
elif keybkey = "ArrowRight"
indk = 2
elif keybkey = "ArrowDown"
indk = 3
elif keybkey = "ArrowLeft"
indk = 4
.
handle indk
.

228
Task/2048/Zig/2048.zig Normal file
View file

@ -0,0 +1,228 @@
const std = @import("std");
const io = std.io;
const Random = std.Random;
// UserMove enum representing possible moves
const UserMove = enum {
Up,
Down,
Left,
Right,
};
// Game field type
const Field = [4][4]u32;
// Function to print the current game state
fn printGame(field: *const Field) void {
for (field) |row| {
std.debug.print("{any}\n", .{row});
}
}
// Function to get a user move
fn getUserMove() !UserMove {
const stdin = std.io.getStdIn().reader();
var buf: [2]u8 = undefined; // Buffer for input (character + newline)
while (true) {
const bytesRead = try stdin.read(&buf);
if (bytesRead < 1) continue;
switch (buf[0]) {
'a' => return UserMove.Left,
'w' => return UserMove.Up,
's' => return UserMove.Down,
'd' => return UserMove.Right,
else => {
std.debug.print("input was {c}: invalid character should be a,s,w or d\n", .{buf[0]});
},
}
}
}
// This function implements user moves.
// For every element, it checks if the element is zero.
// If the element is zero, it looks against the direction of movement if any
// element is not zero, then moves it to its place and checks for a matching element.
// If the element is not zero, it looks for a match. If no match is found,
// it looks for the next element.
fn doGameStep(step: UserMove, field: *Field) void {
switch (step) {
.Left => {
for (field) |*row| {
for (0..4) |col| {
for ((col + 1)..4) |my_testCol| {
if (row[my_testCol] != 0) {
if (row[col] == 0) {
row[col] += row[my_testCol];
row[my_testCol] = 0;
} else if (row[col] == row[my_testCol]) {
row[col] += row[my_testCol];
row[my_testCol] = 0;
break;
} else {
break;
}
}
}
}
}
},
.Right => {
for (field) |*row| {
var col: i32 = 3;
while (col >= 0) : (col -= 1) {
var my_testCol: i32 = col - 1;
while (my_testCol >= 0) : (my_testCol -= 1) {
if (row[@intCast(my_testCol)] != 0) {
if (row[@intCast(col)] == 0) {
row[@intCast(col)] += row[@intCast(my_testCol)];
row[@intCast(my_testCol)] = 0;
} else if (row[@intCast(col)] == row[@intCast(my_testCol)]) {
row[@intCast(col)] += row[@intCast(my_testCol)];
row[@intCast(my_testCol)] = 0;
break;
} else {
break;
}
}
}
}
}
},
.Down => {
for (0..4) |col_idx| {
const col = col_idx; // Convert to immutable
var row: i32 = 3;
while (row >= 0) : (row -= 1) {
var my_testRow: i32 = row - 1;
while (my_testRow >= 0) : (my_testRow -= 1) {
if (field[@intCast(my_testRow)][col] != 0) {
if (field[@intCast(row)][col] == 0) {
field[@intCast(row)][col] += field[@intCast(my_testRow)][col];
field[@intCast(my_testRow)][col] = 0;
} else if (field[@intCast(row)][col] == field[@intCast(my_testRow)][col]) {
field[@intCast(row)][col] += field[@intCast(my_testRow)][col];
field[@intCast(my_testRow)][col] = 0;
break;
} else {
break;
}
}
}
}
}
},
.Up => {
for (0..4) |col| {
for (0..4) |row| {
for ((row + 1)..4) |my_testRow| {
if (field[my_testRow][col] != 0) {
if (field[row][col] == 0) {
field[row][col] += field[my_testRow][col];
field[my_testRow][col] = 0;
} else if (field[row][col] == field[my_testRow][col]) {
field[row][col] += field[my_testRow][col];
field[my_testRow][col] = 0;
break;
} else {
break;
}
}
}
}
}
},
}
}
// Spawn a new number (2 or 4) in a random empty cell
fn spawn(field: *Field, random: Random) void {
while (true) {
const x = random.uintLessThan(usize, 16); // Random position 0-15
const row = x % 4;
const col = (x / 4) % 4;
if (field[row][col] == 0) {
// 10% chance for a 4, 90% chance for a 2
if (random.uintLessThan(usize, 10) == 0) {
field[row][col] = 4;
} else {
field[row][col] = 2;
}
break;
}
}
}
// Check if fields are equal
fn areFieldsEqual(a: *const Field, b: *const Field) bool {
for (0..4) |i| {
for (0..4) |j| {
if (a[i][j] != b[i][j]) return false;
}
}
return true;
}
// Check if player has won (any tile equals 2048)
fn checkWin(field: *const Field) bool {
for (field) |row| {
for (row) |cell| {
if (cell == 2048) return true;
}
}
return false;
}
pub fn main() !void {
var prng = std.Random.DefaultPrng.init(@intCast(std.time.milliTimestamp()));
const random = prng.random();
var field: Field = [_][4]u32{[_]u32{0} ** 4} ** 4;
var my_test: Field = undefined;
gameLoop: while (true) {
// Check if there's still an open space
@memcpy(&my_test, &field);
spawn(&field, random);
// Check if any valid moves remain
var validMoveExists = false;
const moves = [_]UserMove{ .Up, .Down, .Left, .Right };
for (moves) |move| {
@memcpy(&my_test, &field);
doGameStep(move, &my_test);
if (!areFieldsEqual(&my_test, &field)) {
validMoveExists = true;
break;
}
}
if (!validMoveExists) {
std.debug.print("No more valid moves, you lose\n", .{});
break :gameLoop;
}
// Print the current game state
printGame(&field);
std.debug.print("move the blocks\n", .{});
// Get and apply user move
@memcpy(&my_test, &field);
while (areFieldsEqual(&my_test, &field)) {
const move = try getUserMove();
doGameStep(move, &field);
}
// Check win condition
if (checkWin(&field)) {
printGame(&field);
std.debug.print("You Won!!\n", .{});
break :gameLoop;
}
}
}

View file

@ -0,0 +1,226 @@
enum Operator {
Sub,
Plus,
Mul,
Div
}
class Factor {
String content;
int value;
Factor({this.content, this.value});
Factor copyWith({String content, int value}) {
return Factor(
content: content ?? this.content,
value: value ?? this.value
);
}
}
List<Factor> apply(Operator op, List<Factor> left, List<Factor> right) {
List<Factor> ret = [];
for (var l in left) {
for (var r in right) {
switch (op) {
case Operator.Sub:
if (l.value > r.value) {
ret.add(Factor(
content: "(${l.content} - ${r.content})",
value: l.value - r.value
));
}
break;
case Operator.Plus:
ret.add(Factor(
content: "(${l.content} + ${r.content})",
value: l.value + r.value
));
break;
case Operator.Mul:
ret.add(Factor(
content: "(${l.content} × ${r.content})",
value: l.value * r.value
));
break;
case Operator.Div:
if (l.value >= r.value && r.value > 0 && l.value % r.value == 0) {
ret.add(Factor(
content: "(${l.content} / ${r.content})",
value: l.value ~/ r.value
));
}
break;
}
}
}
return ret;
}
List<Factor> calc(List<Operator> op, List<int> numbers) {
List<Factor> _calc(List<Operator> op, List<int> numbers, List<Factor> acc) {
if (op.isEmpty) {
return List<Factor>.from(acc);
}
List<Factor> ret = [];
var monoFactor = [Factor(
content: numbers[0].toString(),
value: numbers[0],
)];
switch (op[0]) {
case Operator.Mul:
ret.addAll(apply(op[0], acc, monoFactor));
break;
case Operator.Div:
ret.addAll(apply(op[0], acc, monoFactor));
ret.addAll(apply(op[0], monoFactor, acc));
break;
case Operator.Sub:
ret.addAll(apply(op[0], acc, monoFactor));
ret.addAll(apply(op[0], monoFactor, acc));
break;
case Operator.Plus:
ret.addAll(apply(op[0], acc, monoFactor));
break;
}
return _calc(
op.sublist(1),
numbers.sublist(1),
ret
);
}
return _calc(
op,
numbers.sublist(1),
[Factor(content: numbers[0].toString(), value: numbers[0])]
);
}
List<Factor> solutions(List<int> numbers) {
List<Factor> ret = [];
Set<String> hashSet = {};
for (var ops in OpIter()) {
for (var order in orders()) {
var orderedNumbers = applyOrder(numbers, order);
var results = calc(ops, orderedNumbers);
for (var factor in results) {
if (factor.value == 24 && !hashSet.contains(factor.content)) {
hashSet.add(factor.content);
ret.add(factor);
}
}
}
}
return ret;
}
class OpIter extends Iterable<List<Operator>> {
@override
Iterator<List<Operator>> get iterator => _OpIterator();
}
class _OpIterator implements Iterator<List<Operator>> {
int _index = 0;
static const List<Operator> OPTIONS = [
Operator.Mul,
Operator.Sub,
Operator.Plus,
Operator.Div
];
@override
List<Operator> get current {
final f1 = OPTIONS[(_index & (3 << 4)) >> 4];
final f2 = OPTIONS[(_index & (3 << 2)) >> 2];
final f3 = OPTIONS[(_index & 3)];
return [f1, f2, f3];
}
@override
bool moveNext() {
if (_index >= 1 << 6) {
return false;
}
_index++;
return true;
}
}
List<List<int>> orders() {
return [
[0, 1, 2, 3],
[0, 1, 3, 2],
[0, 2, 1, 3],
[0, 2, 3, 1],
[0, 3, 1, 2],
[0, 3, 2, 1],
[1, 0, 2, 3],
[1, 0, 3, 2],
[1, 2, 0, 3],
[1, 2, 3, 0],
[1, 3, 0, 2],
[1, 3, 2, 0],
[2, 0, 1, 3],
[2, 0, 3, 1],
[2, 1, 0, 3],
[2, 1, 3, 0],
[2, 3, 0, 1],
[2, 3, 1, 0],
[3, 0, 1, 2],
[3, 0, 2, 1],
[3, 1, 0, 2],
[3, 1, 2, 0],
[3, 2, 0, 1],
[3, 2, 1, 0]
];
}
List<int> applyOrder(List<int> numbers, List<int> order) {
return [
numbers[order[0]],
numbers[order[1]],
numbers[order[2]],
numbers[order[3]]
];
}
void main(List<String> args) {
List<int> numbers = [];
if (args.isNotEmpty) {
String input = args[0];
for (var char in input.split('')) {
int n = int.tryParse(char);
if (n != null) {
numbers.add(n);
}
if (numbers.length == 4) {
var sols = solutions(numbers);
var len = sols.length;
if (len == 0) {
print('no solution for ${numbers[0]}, ${numbers[1]}, ${numbers[2]}, ${numbers[3]}');
return;
}
print('solutions for ${numbers[0]}, ${numbers[1]}, ${numbers[2]}, ${numbers[3]}');
for (var s in sols) {
print(s.content);
}
print('$len solutions found');
return;
}
}
} else {
print('empty input');
}
}

View file

@ -3,8 +3,6 @@ import system'collections;
import system'dynamic;
import extensions;
// --- Expression ---
class ExpressionTree
{
object _tree;
@ -18,13 +16,13 @@ class ExpressionTree
var node := new DynamicStruct();
ch =>
$43 { node.Level := level + 1; node.Operation := mssg add } // +
$45 { node.Level := level + 1; node.Operation := mssg subtract } // -
$42 { node.Level := level + 2; node.Operation := mssg multiply } // *
$47 { node.Level := level + 2; node.Operation := mssg divide } // /
$40 { level.append(10); ^ self } // (
$41 { level.reduce(10); ^ self } // )
! {
$43 : { node.Level := level + 1; node.Operation := mssg add } // +
$45 : { node.Level := level + 1; node.Operation := mssg subtract } // -
$42 : { node.Level := level + 2; node.Operation := mssg multiply } // *
$47 : { node.Level := level + 2; node.Operation := mssg divide } // /
$40 : { level.append(10); ^ self } // (
$41 : { level.reduce(10); ^ self } // )
! : {
node.Leaf := ch.toString().toReal();
node.Level := level + 3
};
@ -97,8 +95,6 @@ class ExpressionTree
<= readLeaves(list,_tree);
}
// --- Game ---
class TwentyFourGame
{
object theNumbers;
@ -121,7 +117,7 @@ class TwentyFourGame
help()
{
console
Console
.printLine("------------------------------- Instructions ------------------------------")
.printLine("Four digits will be displayed.")
.printLine("Enter an equation using all of those four digits that evaluates to 24")
@ -137,9 +133,9 @@ class TwentyFourGame
prompt()
{
theNumbers.forEach::(n){ console.print(n," ") };
theNumbers.forEach::(n){ Console.print(n," ") };
console.print(": ")
Console.print(": ")
}
resolve(expr)
@ -149,19 +145,19 @@ class TwentyFourGame
var leaves := new ArrayList();
tree.readLeaves(leaves);
ifnot (leaves.ascendant().sequenceEqual(theNumbers.ascendant()))
{ console.printLine("Invalid input. Enter an equation using all of those four digits. Try again."); ^ self };
if:not (leaves.ascendant().sequenceEqual(theNumbers.ascendant()))
{ Console.printLine("Invalid input. Enter an equation using all of those four digits. Try again."); ^ self };
var result := tree.Value;
if (result == 24)
{
console.printLine("Good work. ",expr,"=",result);
Console.printLine("Good work. ",expr,"=",result);
self.newPuzzle()
}
else
{
console.printLine("Incorrect. ",expr,"=",result)
Console.printLine("Incorrect. ",expr,"=",result)
}
}
}
@ -178,7 +174,7 @@ extension gameOp
{
if (expr == "")
{
console.printLine("Skipping this puzzle"); self.newPuzzle()
Console.printLine("Skipping this puzzle"); self.newPuzzle()
}
else
{
@ -188,8 +184,7 @@ extension gameOp
}
catch(Exception e)
{
console.printLine(e)
//console.printLine:"An error occurred. Check your input and try again."
Console.printLine:"An error occurred. Check your input and try again."
}
};
@ -198,11 +193,9 @@ extension gameOp
}
}
// --- program ---
public program()
{
var game := new TwentyFourGame().help();
while (game.prompt().playRound(console.readLine())) {}
while (game.prompt().playRound(Console.readLine())) {}
}

View file

@ -25,18 +25,21 @@ while (1) {
print "Expression (try ", $try++, "): ";
my $entry = <>;
if (!defined $entry || $entry eq 'q')
if (!defined $entry || substr($entry,0,1) eq 'q')
{ say "Goodbye. Sorry you couldn't win."; last; }
$entry =~ s/\s+//g; # remove all white space
$entry =~ s/\s+//g; # remove all white space (newline is whitespace too)
next if $entry eq '';
my $given_digits = join "", sort @digits;
my $entry_digits = join "", sort grep { /\d/ } split(//, $entry);
if ($given_digits ne $entry_digits || # not correct digits
$entry =~ /\d\d/ || # combined digits
$entry =~ m|[-+*/]{2}| || # combined operators
$entry =~ tr|-0-9()+*/||c) # Invalid characters
{ say "That's not valid"; next; }
if ($given_digits ne $entry_digits)
{ say "incorrect digits"; next; }
if ($entry =~ /\d\d/)
{ say "error, combined digits"; next; }
if ($entry =~ m|[-+*/]{2}|)
{ say "error, combined operators"; next; }
if ($entry =~ tr|-0-9()+*/||c)
{ say "invalid characters!"; next; }
my $n = eval $entry;

View file

@ -79,7 +79,13 @@ fn calculate(input: &String, list : &mut [u32;4]) -> f32{
fn main() {
let mut rng = rand::thread_rng();
let mut list :[u32;4]=[rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10];
// each from 1 ──► 9 (inclusive)
let mut list :[u32;4]=[
rng.gen::<u32>()%9+1,
rng.gen::<u32>()%9+1,
rng.gen::<u32>()%9+1,
rng.gen::<u32>()%9+1
];
println!("form 24 with using + - / * {:?}",list);
//get user input

View file

@ -0,0 +1,153 @@
const std = @import("std");
const rand = std.Random;
// (hint: errors cannot be handled at comptime)
var stdout: std.fs.File.Writer = undefined;
var stdin: std.fs.File.Reader = undefined;
fn opType(x: u8) i32 {
return switch (x) {
'-', '+' => 1,
'/', '*' => 2,
'(', ')' => -1,
else => 0,
};
}
fn toRpn(allocator: std.mem.Allocator, input: []const u8) ![]u8 {
var rpnString = std.ArrayList(u8).init(allocator);
defer rpnString.deinit();
var rpnStack = std.ArrayList(u8).init(allocator);
defer rpnStack.deinit();
var lastToken: u8 = '#';
for (input) |token| {
if (token >= '1' and token <= '9') {
try rpnString.append(token);
} else if (opType(token) == 0) {
continue;
} else if (opType(token) > opType(lastToken) or token == '(') {
try rpnStack.append(token);
lastToken = token;
} else {
while (rpnStack.items.len > 0) {
const top = rpnStack.pop().?;
if (top == '(') {
break;
}
try rpnString.append(top);
}
if (token != ')') {
try rpnStack.append(token);
}
}
}
while (rpnStack.items.len > 0) {
try rpnString.append(rpnStack.pop().?);
}
if (rpnString.items.len > 0) {
try stdout.print("your formula results in {s}\n", .{rpnString.items});
} else {
stdout.print("no input available.\n", .{}) catch {};
}
return rpnString.toOwnedSlice();
}
fn calculate(input: []const u8, list: *[4]u32) f32 {
var stack = std.ArrayList(f32).init(std.heap.page_allocator);
defer stack.deinit();
var accumulator: f32 = 0.0;
for (input) |token| {
if (token >= '1' and token <= '9') {
const digit = @as(u32, token - '0');
// Find and mark the used digit
var found = false;
for (list, 0..) |val, idx| {
if (val == digit) {
list[idx] = 10;
found = true;
break;
}
}
if (!found) {
stdout.print(" invalid digit: {d} \n", .{digit}) catch {};
}
stack.append(accumulator) catch {};
accumulator = @floatFromInt(digit);
} else {
const a = stack.pop().?;
accumulator = switch (token) {
'-' => a - accumulator,
'+' => a + accumulator,
'/' => a / accumulator,
'*' => a * accumulator,
else => accumulator, // NOP
};
}
}
stdout.print("your formula results in {d}\n", .{accumulator}) catch {};
return accumulator;
}
pub fn main() !void {
stdout = std.io.getStdOut().writer();
stdin = std.io.getStdIn().reader();
var prng = rand.DefaultPrng.init(@as(u64, @intCast(std.time.timestamp())));
const random = prng.random();
// only values from 1 --> 9 (inclusive)
var list = [_]u32{
@mod(random.int(u32), 9) + 1,
@mod(random.int(u32), 9) + 1,
@mod(random.int(u32), 9) + 1,
@mod(random.int(u32), 9) + 1,
};
try stdout.print("form 24 with using + - / * {d} {d} {d} {d}\n", .{ list[0], list[1], list[2], list[3] });
// Get user input
var buffer: [1024]u8 = undefined;
const input = try stdin.readUntilDelimiterOrEof(buffer[0..], '\n') orelse "";
var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
defer arena.deinit();
const allocator = arena.allocator();
// Convert to RPN
const rpnInput = try toRpn(allocator, input);
if (rpnInput.len == 0) {
stdout.print("exit.\n", .{}) catch {};
return;
}
const result = calculate(rpnInput, &list);
var allUsed = true;
for (list) |val| {
if (val != 10) {
allUsed = false;
break;
}
}
if (allUsed) {
try stdout.print("and you used all numbers\n", .{});
if (result == 24.0) {
try stdout.print("you won\n", .{});
} else {
try stdout.print("but your formula doesn't result in 24\n", .{});
}
} else {
try stdout.print("you didn't use all the numbers\n", .{});
}
}

View file

@ -1,12 +1,10 @@
func ok v t[] .
for h in t[]
if v = h
return 0
.
if v = h : return 0
.
return 1
.
proc four lo hi uni show . .
proc four lo hi uni show .
#
subr bf
for f = lo to hi

View file

@ -31,5 +31,5 @@ public program()
{
var bottles := 99;
bottles.bottleEnumerator().forEach(printingLn)
bottles.bottleEnumerator().forEach(PrintingLn)
}

View file

@ -0,0 +1,6 @@
USE: math.parser
100 <iota> <reversed>
[ dup 1 - [ >dec " bottles of beer" append [ " on the wall" append ] keep ] bi@
"Take one down, pass it around" -rot
first CHAR: - = [ 2drop "..." "why's all the rum gone??" ] when ! if leading character is "-" then replace with new string
4array "\n" join print nl ] each

View file

@ -1,63 +1,73 @@
( uxncli 99bottles.rom )
%\n { 0a } %\s { 20 } %\0 { 00 }
%newline { [ LIT2 \n -Console/write ] DEO }
%plural { [ LIT2 "s -Console/write ] DEO }
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|18 @Console/write
|0100 ( -> )
#63 &loop
DUP <print-verse>
[ LIT2 0a -Console/write ] DEO
#01 EQUk ?&done
POP #01 SUB
!&loop
&done BRK
|100
@<print-verse> ( num -- )
DUP <print-bottle> ;dict/wall <print-string>
DUP <print-bottle> [ LIT2 0a -Console/write ] DEO
;dict/take <print-string>
#01 SUB <print-bottle> ;dict/wall !<print-string>
#63
&loop
DUP print/verse
newline
#01 EQUk ?/done
POP #01 SUB
!/done
@<print-bottle> ( num -- )
DUP #00 EQU ?&zero
DUP #01 EQU ?&one
<print-dec> ;dict/bottle <print-string>
[ LIT2 "s -Console/write ] DEO
!&end
&done
POP2
&one ( num -- )
<print-dec> ;dict/bottle <print-string>
!&end
&zero ( num -- )
POP ;dict/no-more <print-string>
;dict/bottle <print-string>
[ LIT2 "s -Console/write ] DEO
( >> )
&end
;dict/of-beer
BRK
@print/verse ( num -- )
DUP /bottle ;msgs/wall /str
DUP /bottle newline
;msgs/take /str
#01 SUB /bottle ;msgs/wall !/str
@print/bottle ( num -- )
DUP #00 EQU ?/bottle/zero
DUP #01 EQU ?/bottle/one
/dec ;msgs/bottle /str
plural
!/bottle/end
&bottle/one ( num -- )
/dec ;msgs/bottle /str
!/bottle/end
&bottle/zero ( num -- )
POP ;msgs/no-more /str
;msgs/bottle /str
plural
( >> )
@<print-string> ( str -- )
&loop
LDAk .Console/write DEO
INC2 LDAk ?&loop
&bottle/end
;msgs/of-beer
( >> )
@print/str ( str -- )
LDAk .Console/write DEO
INC2 LDAk ?/str
POP2 JMP2r
@<print-dec> ( byte -- )
DUP #64 DIV <print-num>/try
DUP #0a DIV <print-num>/try
@print/dec ( byte -- )
DUP #64 DIV /dec/try
DUP #0a DIV /dec/try
( >> )
@<print-num> ( num -- )
#0a DIVk MUL SUB
[ LIT "0 ] ADD .Console/write DEO
JMP2r
&dec/try/num ( num -- )
#0a DIVk MUL SUB
[ LIT "0 ] ADD .Console/write DEO
JMP2r
&try ( num -- )
DUP ?<print-num>
&dec/try ( num -- )
DUP ?/dec/try/num
POP JMP2r
@dict &no-more "No 20 "more $1
&bottle 20 "bottle $1
&of-beer 20 "of 20 "beer 20 $1
&wall "on 20 "the 20 "wall 0a $1
&take "Take 20 "one 20 "down, 20 "pass 20 "it 20 "around 0a $1
@msgs [
&no-more "No \s "more \0
&bottle \s "bottle \0
&of-beer \s "of \s "beer \s \0
&wall "on \s "the \s "wall \n \0
&take "Take \s "one \s "down, \s "pass \s "it \s "around \n \0 ]

View file

@ -0,0 +1,16 @@
import ballerina/io;
public function main() returns error? {
while true {
io:print("Enter two integers separated by a space : ");
string[] s = re ` `.split(io:readln());
if s.length() < 2 {
io:println("Insufficient numbers, try again");
} else {
int a = check int:fromString(s[0]);
int b = check int:fromString(s[1]);
io:println("Their sum is ", a + b, ".");
break;
}
}
}

View file

@ -2,8 +2,8 @@ import extensions;
public program()
{
var A := Integer.new();
var B := Integer.new();
var A := Integer.new();
var B := Integer.new();
console.loadLine(A,B).printLine(A + B)
Console.loadLine(A,B).printLine(A + B)
}

View file

@ -3,7 +3,7 @@ import extensions;
public program()
{
console.printLine(console.readLine()
Console.printLine(Console.readLine()
.split()
.selectBy(mssgconst toInt<intConvertOp>[1])
.summarize())

View file

@ -1,4 +0,0 @@
/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/
parse pull a b /*obtain two numbers from input stream.*/
say a+b /*display the sum to the terminal. */
/*stick a fork in it, we're all done. */

View file

@ -1,4 +0,0 @@
/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/
parse pull a b /*obtain two numbers from input stream.*/
say (a+b) / 1 /*display normalized sum to terminal. */
/*stick a fork in it, we're all done. */

View file

@ -1,6 +0,0 @@
/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/
numeric digits 300 /*the default is nine decimal digits.*/
parse pull a b /*obtain two numbers from input stream.*/
z= (a+b) / 1 /*add and normalize sum, store it in Z.*/
say z /*display normalized sum Z to terminal.*/
/*stick a fork in it, we're all done. */

View file

@ -1,11 +0,0 @@
/*REXX program obtains some numbers from the input stream (the console), shows their sum*/
numeric digits 1000 /*just in case the user gets ka-razy. */
say 'enter some numbers to be summed:' /*display a prompt message to terminal.*/
parse pull y /*obtain all numbers from input stream.*/
many= words(y) /*obtain the number of numbers entered.*/
$= 0 /*initialize the sum to zero. */
do j=1 for many /*process each of the numbers. */
$= $ + word(y, j) /*add one number to the sum. */
end /*j*/
/*stick a fork in it, we're all done. */
say 'sum of ' many " numbers = " $/1 /*display normalized sum $ to terminal.*/

View file

@ -1,8 +0,0 @@
/*REXX program obtains some numbers from the input stream (the console), shows their sum*/
numeric digits 1000 /*just in case the user gets ka-razy. */
say 'enter some numbers to be summed:' /*display a prompt message to terminal.*/
parse pull y /*obtain all numbers from input stream.*/
y=space(y)
y=translate(y,'+',' ')
Interpret 's='y
say 'sum of ' many " numbers = " s/1 /*display normalized sum s to terminal.*/

27
Task/A+B/REXX/a+b.rexx Normal file
View file

@ -0,0 +1,27 @@
-- 1 Jun 2025
include Settings
say 'A+B'
say version
say
do forever
call Charout, 'REXX '
pull x
if x = '' then
leave
parse var x a b
say
say 'As given...'
say 'A =' a
say 'B =' b
say 'A+B =' a+b
say
say 'Normalized...'
say 'A =' a/1
say 'B =' b/1
say 'A+B =' (a+b)/1
say
end
exit
include Abend

View file

@ -0,0 +1,32 @@
import ballerina/io;
function r(string word, string[] bl) returns boolean {
if word == "" { return true; }
int c = word[0].toBytes()[0] | 32;
foreach int i in 0..<bl.length() {
var b = bl[i];
if c == (b.toBytes()[0] | 32) || c == (b.toBytes()[1] | 32) {
bl[i] = bl[0];
bl[0] = b;
if r(word.substring(1), bl.slice(1)) { return true; }
var t = bl[i];
bl[i] = bl[0];
bl[0] = t;
}
}
return false;
}
function newSpeller(string blocks) returns (function(string) returns boolean) {
string[] bl = re ` `.split(blocks);
return function(string word) returns boolean {
return r(word, bl);
};
}
public function main() {
var sp = newSpeller("BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM");
foreach string word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"] {
io:println(word.padEnd(7), " ", sp(word));
}
}

View file

@ -2,7 +2,7 @@ b$[][] = [ [ "B" "O" ] [ "X" "K" ] [ "D" "Q" ] [ "C" "P" ] [ "N" "A" ] [ "G" "T"
len b[] len b$[][]
global w$[] cnt .
#
proc backtr wi . .
proc backtr wi .
if wi > len w$[]
cnt += 1
return

View file

@ -41,6 +41,6 @@ public program()
words.forEach::(word)
{
console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
Console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
}
}

View file

@ -0,0 +1,117 @@
using System.Diagnostics;
const string cypher = "ADFGVX";
var N = cypher.Length;
var size = N * N;
const string symbols = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
Debug.Assert(size == symbols.Length);
var square = new int[size];
for (var i = 0; i < size; i++)
{
var j = Random.Shared.Next(i + 1);
square[i] = square[j];
square[j] = i;
}
Console.WriteLine($"{N} x {N} Polybius square:");
Console.WriteLine();
Console.WriteLine($" | {string.Join(' ', cypher.AsEnumerable())}");
Console.WriteLine(new string('-', 2 * N + 3));
for (var row = 0; row < N; row++)
{
Console.Write($"{cypher[row]} |");
for (var col = 0; col < N; col++)
{
Console.Write($" {symbols[square[col + row * N]]}");
}
Console.WriteLine();
}
static bool IsSuitableTranspositionKey(string s) =>
s.Length >= 7 && s.Length <= 12 && s.Length == s.Distinct().Count() && s.All(symbols.ToLowerInvariant().Contains);
var keys = File.ReadAllLines("unixdict.txt").Where(IsSuitableTranspositionKey).ToArray();
var key = keys[Random.Shared.Next(keys.Length)].ToUpperInvariant();
Console.WriteLine();
Console.WriteLine($"The key is {key}");
var plaintext = "ATTACKAT1200AM";
Console.WriteLine($"Plaintext: {plaintext}");
string Encrypt(string plaintext, string key, int[] square)
{
// Create a lookup table from symbol to fragment
var map = (from i in Enumerable.Range(0, size)
let k = square[i]
let code = cypher[i / N] + "" + cypher[i % N]
select (k, code))
.ToDictionary(kc => symbols[kc.k], kc => kc.code);
// Map the plaintext to fragments
var e = string.Join("", plaintext.Select(c => map[c]));
// Determine number of rows
var K = key.Length;
var rows = (e.Length + K - 1) / K;
// Pad with spaces
e += new string(' ', rows * K - e.Length);
// Sort the key
var order = string.Join("", key.OrderBy(c => c)).Select(c => key.IndexOf(c)).ToArray();
// Reorder the fragments.
e = string.Join("", Enumerable.Range(0, K * rows).Select(i => e[(i / K) * K + order[i % K]]));
// Transpose
e = new([.. from col in Enumerable.Range(0, K)
from row in Enumerable.Range(0, rows)
select e[row * K + col]]);
// Read off each column.
return string.Join(" ", Enumerable.Range(0, K).Select(col => e.Substring(col * rows, rows).Trim()));
}
var encrypted = Encrypt(plaintext, key, square);
Console.WriteLine($"Encrypted: {encrypted}");
string Decrypt(string encrypted, string key, int[] square)
{
// Create a lookup table from fragment to symbol
var map = (from i in Enumerable.Range(0, size)
let k = square[i]
let code = cypher[i / N] + "" + cypher[i % N]
select (k, code))
.ToDictionary(kc => kc.code, kc => symbols[kc.k]);
// Split into columns
var cols = encrypted.Split(' ');
// Determine number of rows
var K = key.Length;
var rows = cols.Max(c => c.Length);
// Pad each column
cols = [.. cols.Select(c => c.PadRight(rows))];
// Transpose
string e = new([.. from row in Enumerable.Range(0, rows)
from col in Enumerable.Range(0, K)
select cols[col][row]]);
// Sort the key
var sorted = string.Join("", key.OrderBy(c => c));
var order = key.Select(c => sorted.IndexOf(c)).ToArray();
// Reorder the fragments
e = string.Join("", Enumerable.Range(0, K * rows).Select(i => e[(i / K) * K + order[i % K]])).Trim();
// Map the fragments to plaintext
return string.Join("", Enumerable.Range(0, e.Length / 2).Select(i => map[e.Substring(2 * i, 2)]));
}
var decrypted = Decrypt(encrypted, key, square);
Console.WriteLine($"Decrypted: {decrypted}");

View file

@ -0,0 +1,134 @@
class ADFGVX {
/** The WWI German ADFGVX cipher. */
constructor(spoly, k, alph = 'ADFGVX') {
this.polybius = spoly.toUpperCase().split('');
this.pdim = Math.floor(Math.sqrt(this.polybius.length));
this.key = k.toUpperCase().split('');
this.keylen = this.key.length;
this.alphabet = alph.split('');
const pairs = [];
for (let i = 0; i < this.alphabet.length; i++) {
for (let j = 0; j < this.alphabet.length; j++) {
pairs.push(this.alphabet[i] + this.alphabet[j]);
}
}
this.encode = {};
for (let i = 0; i < this.polybius.length; i++) {
this.encode[this.polybius[i]] = pairs[i];
}
this.decode = {};
for (const k in this.encode) {
this.decode[this.encode[k]] = k;
}
}
encrypt(msg) {
/** Encrypt with the ADFGVX cipher. */
const chars = [];
for (const c of msg.toUpperCase()) {
if (this.polybius.includes(c)) {
chars.push(this.encode[c]);
}
}
const flatChars = chars.join('').split('');
const colvecs = [];
for (let i = 0; i < this.keylen; i++) {
const currentCol = [];
for (let j = i; j < flatChars.length; j += this.keylen) {
currentCol.push(flatChars[j]);
}
colvecs.push([this.key[i], currentCol]);
}
colvecs.sort((a, b) => a[0].localeCompare(b[0]));
let result = '';
for (const a of colvecs) {
result += a[1].join('');
}
return result;
}
decrypt(cod) {
/** Decrypt with the ADFGVX cipher. Does not depend on spacing of encoded text */
const chars = [];
for (const c of cod) {
if (this.alphabet.includes(c)) {
chars.push(c);
}
}
const sortedkey = [...this.key].sort();
const order = [];
for (const ch of sortedkey) {
order.push(this.key.indexOf(ch));
}
const originalorder = [];
for (const ch of this.key) {
originalorder.push(sortedkey.indexOf(ch));
}
const base = Math.floor(chars.length / this.keylen);
const extra = chars.length % this.keylen;
const strides = order.map((_, i) => base + (extra > i ? 1 : 0));
const starts = [0];
let sum = 0;
for (let i = 0; i < strides.length - 1; i++) {
sum += strides[i];
starts.push(sum);
}
const ends = starts.map((start, i) => start + strides[i]);
const cols = originalorder.map(i => chars.slice(starts[i], ends[i]));
const pairs = [];
for (let i = 0; i < Math.floor((chars.length - 1) / this.keylen) + 1; i++) {
for (let j = 0; j < this.keylen; j++) {
if (i * this.keylen + j < chars.length) {
pairs.push(cols[j][i]);
}
}
}
let decoded = '';
for (let i = 0; i < pairs.length; i += 2) {
decoded += this.decode[pairs[i] + pairs[i + 1]];
}
return decoded;
}
}
// Helper function to shuffle an array (Fisher-Yates shuffle)
function shuffle(array) {
for (let i = array.length - 1; i > 0; i--) {
const j = Math.floor(Math.random() * (i + 1));
[array[i], array[j]] = [array[j], array[i]];
}
return array;
}
async function main() {
const PCHARS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'.split('');
shuffle(PCHARS);
const POLYBIUS = PCHARS.join('');
// Simulate reading from unixdict.txt (replace with your actual file reading method if needed)
// For demonstration purposes, using a hardcoded word list:
const WORDS = ['ABDEFGHIK', 'JLMNOPQRS', 'TUVWXYZ01', '23456789'];
const KEY = WORDS[Math.floor(Math.random() * WORDS.length)];
const SECRET = new ADFGVX(POLYBIUS, KEY);
const MESSAGE = 'ATTACKAT1200AM';
console.log(`Polybius: ${POLYBIUS}, key: ${KEY}`);
console.log('Message: ', MESSAGE);
const ENCODED = SECRET.encrypt(MESSAGE);
const DECODED = SECRET.decrypt(ENCODED);
console.log('Encoded: ', ENCODED);
console.log('Decoded: ', DECODED);
}
main();

View file

@ -0,0 +1,116 @@
Module CheckADFGVX_Cipher {
Class cipher {
Private:
buffer a as byte*36
b="ADFGVX"
key="ABCDEFGHIJK"
orderkey="ABCDEFGHIJK"
map=list
map2=list
module preparemaps {
for i=0 to 5
jj=0
for j=i*6 to j+5
.map(chr$(.a[j]))=mid$(.b, i+1,1)+mid$(.b,jj+1, 1)
.map2(mid$(.b, i+1,1)+mid$(.b,jj+1, 1))=chr$(.a[j])
jj++
next
next
}
Public:
Module SetRandom (&returnvalue) {
return .a, 0:=str$("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
for i=1 to 100
c=random(0, 35):d=c
while c=d {d=random(0, 35)}
byte o=.a[c]
.a[c]<=.a[d]
.a[d]<=o
next
returnvalue=chr$(eval$(.a)) ' convert to UTF16LE
.preparemaps
}
Module SetSpecific (that$){
return .a, 0:=str$(Ucase$(that$))
.preparemaps
}
Module SetKey (.key as string) {
.key<=ucase$(.key)
if len(.key)<7 or len(.key)>12 then Error "Key has not proper length"
if filter$(.key, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")<>"" then
Error "Key has bad letters"
end if
dim aa(1 to len(.key))
for i=1 to len(.key):aa(i)=mid$(.key,i,1):next
.orderkey<=aa()#sort()#str$("")
}
Module Display {
Print "The 6 x 6 Polybius square:"
Print " | A D F G V X"
Print "---------------"
for i=0 to 5
Print mid$(.b,i+1,1)+" | ";
jj=0
for j=i*6 to j+5
print chr$(.a[j]);" ";
jj++
next
print
next
Print "Key:";.key
}
Function Encrypt(p as string) {
crypted=""
for i=1 to len(p)
crypted+=.map$(mid$(p,i,1))
next
m=1
encrypted=""
For i = 1 To Len(.key)
ch = Mid$(.orderkey, i, 1)
For j = Instr(.key, ch) - 1 To Len(crypted) - 1 Step Len(.key)
encrypted += Mid$(crypted, j + 1, 1)
if m mod 5=0 then encrypted += " "
m++
Next
Next
=encrypted
}
Function Decrypt(p as string) {
p=filter$(p, " ")
decrypted=""
m=1
dim b$(len(p))
For i = 1 To Len(.key)
ch = Mid$(.orderkey, i, 1)
For j = Instr(.key, ch) - 1 To Len(p) - 1 Step Len(.key)
b$(j)=mid$(p, m, 1)
m++
Next
Next
for i=0 to len(b$())-1 step 2
decrypted+=.map2(b$(i)+b$(i+1))
next
=decrypted
}
}
ADFGVX=cipher()
for ADFGVX {
.SetSpecific "A9GKMF1DQRSBVX8Z0WTEJLOPY5U4CN2H76I3"
.SetKey "volcanism"
.Display
encode=.Encrypt("ATTACKAT1200AM")
Print "Encoded: ";encode
Print "Decoded: ";.Decrypt(encode)
Rem { ' using randomblock
thisblock=""
.SetRandom &thisblock
Print "Random Block:";thisblock
.Display
encode=.Encrypt("ATTACKAT1200AM")
Print "Encoded: ";encode
Print "Decoded: ";.Decrypt(encode)
}
}
}
CheckADFGVX_Cipher

View file

@ -0,0 +1,58 @@
import ballerina/io;
int[] e = "²³⁴⁵⁶⁷".toCodePointInts();
function bc(int p) returns int[] {
int[] c = [];
c.setLength(p + 1);
int r = 1;
int half = p / 2;
foreach int i in 0...half {
c[i] = r;
c[p - i] = r;
r = r * (p - i) / (i + 1);
}
foreach int i in int:range(p - 1, -1, -2) {
c[i] = -c[i];
}
return c;
}
function pp(int[] c) returns string|error {
if c.length() == 1 { return c[0].toString(); }
int p = c.length() - 1;
string s = "";
if c[p] != 1 { s = c[p].toString(); }
foreach int i in int:range(p, 0, -1) {
s += "x";
if i != 1 { s += check string:fromCodePointInt(e[i - 2]); }
int d = c[i - 1];
if d < 0 {
s += " - " + (-d).toString();
} else {
s += " + " + d.toString();
}
}
return s;
}
function aks(int p) returns boolean {
int[] c = bc(p);
c[p] -= 1;
c[0] += 1;
foreach int d in c {
if d % p != 0 { return false; }
}
return true;
}
public function main() {
foreach int p in 0...7 {
io:println(p, ": ", pp(bc(p)));
}
io:println("\nAll primes under 50:");
foreach int p in 2...49 {
if aks(p) { io:print(p, " "); }
}
io:println();
}

View file

@ -45,7 +45,7 @@ singleton AksTest
while(i != 0)
{
i -= 1;
console.print("+",c[i],"x^",i)
Console.print("+",c[i],"x^",i)
}
}
}
@ -55,18 +55,18 @@ public program()
for (int n := 0; n < 10; n += 1) {
AksTest.coef(n);
console.print("(x-1)^",n," = ");
Console.print("(x-1)^",n," = ");
AksTest.show(n);
console.printLine()
Console.printLine()
};
console.print("Primes:");
Console.print("Primes:");
for (int n := 1; n <= 63; n += 1) {
if (AksTest.is_prime(n))
{
console.print(n," ")
Console.print(n," ")
}
};
console.printLine().readChar()
Console.printLine().readChar()
}

View file

@ -1,43 +1,91 @@
/*REXX program calculates primes via the Agrawal─Kayal─Saxena (AKS) primality test.*/
parse arg Z . /*obtain optional argument from the CL.*/
if Z=='' | Z=="," then Z= 200 /*Not specified? Then use the default.*/
OZ=Z; tell= Z<0; Z= abs(Z) /*Is Z negative? Then show expression.*/
numeric digits max(9, Z % 3) /*define a dynamic # of decimal digits.*/
call AKS /*invoke the AKS funtion for coef. bld.*/
if left(OZ,1)=='+' then do; say Z isAksp(); exit /*display if Z is or isn't a prime.*/
end /* [↑] call isAKSp if Z has leading +.*/
say; say "primes found:" # /*display the prime number list. */
say; if \datatype(#, 'W') then exit /* [↓] the digit length of a big coef.*/
say 'Found ' words(#) " primes and the largest coefficient has " length(@.pm.h) @dd
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
AKS: $.0= '-'; $.1= "+"; @. = 1 /*$.x: sign char; default coefficients.*/
q.= 1; q.1= 0; q.4= 0 /*sparse array for faster comparisons. */
#=; L= length(Z) /*define list of prime numbers (so far)*/
do p=3 for Z; pm=p - 1; pp=p + 1 /*PM & PP: used as a coding convenience*/
do m=2 for pp % 2 - 1; mm=m - 1 /*calculate coefficients for a power. */
@.p.m= @.pm.mm + @.pm.m; h=pp - m /*calculate left side of coefficients*/
@.p.h= @.p.m /* " right " " " */
end /*m*/ /* [↑] The M DO loop creates both */
end /*p*/ /* sides in the same loop. */
if tell then say '(x-1)^'right(0, L)": 1" /*possibly display the first expression*/
@dd= 'decimal digits.' /* [↓] test for primality by division.*/
do n=2 for Z; nh=n % 2; d= n - 1 /*create expressions; find the primes.*/
do k=3 to nh while @.n.k//d == 0 /*are coefficients divisible by N-1 ? */
end /*k*/ /* [↑] skip the 1st & 2nd coefficients*/
if k>nh then if q.d then #= # d /*add a number to the prime list. */
if \tell then iterate /*Don't tell? Don't show expressions.*/
y= '(x-1)^'right(d, L)":" /*define the 1st part of the expression*/
s=1 /*S: is the sign indicator (-1│+1).*/
do j=n for n-1 by -1 /*create the higher powers first. */
if j==2 then xp= 'x' /*if power=1, then don't show the power*/
else xp= 'x^' || j-1 /* ··· else show power with ^ */
if j==n then y=y xp /*no sign (+│-) for the 1st expression.*/
else y=y $.s || @.n.j''xp /*build the expression with sign (+|-).*/
s= \s /*flip the sign for the next expression*/
end /*j*/ /* [↑] the sign (now) is either 0 │ 1,*/
say y $.s'1' /*just show the first N expressions, */
end /*n*/ /* [↑] ··· but only for negative Z. */
if #=='' then #= "none"; return # /*if null, return "none"; else return #*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
isAKSp: if z==word(#,words(#)) then return ' is a prime.'; else return " isn't a prime."
-- 22 Mar 2025
include Settings
say 'AKS TEST FOR PRIMES'
say version
say
arg p
if p = '' then
p = 10
numeric digits Max(10,Abs(p)%3)
call Combis p
call Polynomials p
call Showprimes p
exit
Combis:
procedure expose comb.
arg p
call Time('r')
if p > 0 then
say 'Combinations up to' p'...'
else
say 'Combinations for' Abs(p)'...'
say Combinations(p) 'combinations generated'
say Format(Time('e'),,3) 'seconds'
say
return
Polynomials:
procedure expose poly. comb. work. prim.
arg p
call Time('r')
say 'Polynomials...'
if p < 0 then
b = Abs(p)
else
b = 0
p = Abs(p); prim. = 0; n = 0
do i = b to p
a = Ppow('1 -1',i)
if i < 11 then
say '(x-1)^'i '=' Plst2form(Parr2lst())
s = 1
do j = 2 to poly.0-1
a = poly.coef.j
if a//i > 0 then do
s = 0
leave j
end
end
if s = 1 then do
if i > 1 then do
n = n+1
prim.n = i
end
end
end
prim.0 = n
say Format(Time('e'),,3) 'seconds'
say
return
Showprimes:
procedure expose prim.
arg p
call Time('r')
say 'Primes...'
if p < 0 then do
p = Abs(p)
if prim.0 > 0 then
say p 'is prime'
else
say p 'is not prime'
end
else do
do i = 1 to prim.0
call Charout ,Right(prim.i,5)
if i//20 = 0 then
say
end
say
end
say Format(Time('e'),,3) 'seconds'
say
return
include Functions
include Numbers
include Polynomial
include Sequences
include Abend

View file

@ -1,89 +0,0 @@
include Settings
say version
say 'AKS-test for primes'; say
arg p
if p = '' then
p = 10
numeric digits Max(10,Abs(p)%3)
call Combis p
call Polynomials p
call Showprimes p
exit
Combis:
procedure expose comb.
arg p
call Time('r')
if p > 0 then
say 'Combinations up to' p'...'
else
say 'Combinations for' Abs(p)'...'
say Combinations(p) 'combinations generated'
say Format(Time('e'),,3) 'seconds'
say
return
Polynomials:
procedure expose poly. comb. work. prim.
arg p
call Time('r')
say 'Polynomials...'
if p < 0 then
b = Abs(p)
else
b = 0
p = Abs(p); prim. = 0; n = 0
do i = b to p
a = Ppow('1 -1',i)
if i < 11 then
say '(x-1)^'i '=' Plst2form(Parr2lst())
s = 1
do j = 2 to poly.0-1
a = poly.coef.j
if a//i > 0 then do
s = 0
leave j
end
end
if s = 1 then do
if i > 1 then do
n = n+1
prim.n = i
end
end
end
prim.0 = n
say Format(Time('e'),,3) 'seconds'
say
return
Showprimes:
procedure expose prim.
arg p
call Time('r')
say 'Primes...'
if p < 0 then do
p = Abs(p)
if prim.0 > 0 then
say p 'is prime'
else
say p 'is not prime'
end
else do
do i = 1 to prim.0
call Charout ,Right(prim.i,5)
if i//20 = 0 then
say
end
say
end
say Format(Time('e'),,3) 'seconds'
say
return
include Functions
include Numbers
include Polynomial
include Sequences
include Abend

View file

@ -0,0 +1,190 @@
using System.CodeDom.Compiler;
using System.Diagnostics;
var format = @"+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ID |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|QR| Opcode |AA|TC|RD|RA| Z | RCODE |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| QDCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ANCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| NSCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ARCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+";
var lines = format.Split('\n')
.Select(line => line.Trim())
.Where(s => s.Length > 0)
.ToArray();
var first = lines[0];
var ll = first.Length;
if (lines.Any(line => line.Length != ll))
throw new Exception("Lines are not the same length.");
if (first[0] != '+' || first[^1] != '+')
throw new Exception("First line does not start and end with '+'.");
var bits = first.Split('+')[1..^1];
if (bits.Any(bit => bit != "--"))
throw new Exception("Not all bits on first line match '+--+'.");
if (lines.Length % 2 == 0)
throw new Exception("Expected an odd number of definition lines.");
var rows = lines.Length / 2;
if (Enumerable.Range(0, rows).Any(row => lines[2 * row + 2] != first))
throw new Exception("Not all line separators match first line.");
var width = bits.Length;
if (width != 8 && width != 16 && width != 32 && width != 64)
throw new Exception("Bit width is not 8, 16, 32, or 64.");
var ftype = width switch
{
8 => "byte",
16 => "ushort",
32 => "uint",
_ => "ulong"
};
const string filename = "Header.cs";
const string structName = "Header";
List<(string Name, int Width)> fieldList = [];
List<string> backing = [];
using (var file = File.CreateText(filename))
using (var code = new IndentedTextWriter(file))
{
code.WriteLine("using System.Buffers.Binary;");
code.WriteLine("using System.Runtime.InteropServices;");
code.WriteLine();
code.WriteLine("[StructLayout(LayoutKind.Sequential, Pack = 0)]");
code.WriteLine($"public struct {structName}");
code.WriteLine("{");
code.Indent++;
code.WriteLine($"public static readonly int MarshalledSize = Marshal.SizeOf<{structName}>();");
for (var row = 0; row < rows; row++)
{
var def = lines[row * 2 + 1];
if (def[0] != '|' || def[^1] != '|')
throw new Exception($"Row {row} doesn't start and end with '|'.");
var fields = def.Split('|')[1..^1];
if (fields.Length > 1)
{
code.WriteLine();
code.WriteLine($"{ftype} data{row};");
backing.Add($"data{row}");
}
var offset = width;
foreach (var field in fields)
{
if (field.Length % 3 != 2)
throw new Exception($"Field '{field.Trim()}' delimiters misaligned.");
var fname = field.Trim();
if (fname.Length == 0)
throw new Exception($"Field name is missing.");
var fwidth = (field.Length + 1) / 3;
offset -= fwidth;
fieldList.Add((fname, fwidth));
var mask = "0b" + new string('1', fwidth);
var nmask = "0b" + new string('1', width - fwidth - offset) + new string('0', fwidth) + new string('1', offset);
code.WriteLine();
code.WriteLine($"public {ftype} {fname}");
code.WriteLine("{");
code.Indent++;
if (fields.Length == 1)
{
code.WriteLine("readonly get;");
code.WriteLine("set;");
backing.Add(fname);
}
else
{
code.WriteLine($"readonly get {{ return ({ftype})((data{row} >> {offset}) & {mask});}}");
code.WriteLine($"set {{ data{row} = ({ftype})((data{row} & {nmask}) | ((value & {mask}) << {offset})); }}");
}
code.Indent--;
code.WriteLine("}");
}
}
code.WriteLine();
code.WriteLine($"public static {structName} FromArray(byte[] bytes)");
code.WriteLine("{");
code.Indent++;
code.WriteLine("var handle = GCHandle.Alloc(bytes, GCHandleType.Pinned);");
code.WriteLine($"var result = Marshal.PtrToStructure<{structName}>(handle.AddrOfPinnedObject());");
code.WriteLine("handle.Free();");
if (width > 8)
{
code.WriteLine();
code.WriteLine("if (BitConverter.IsLittleEndian)");
code.WriteLine("{");
code.Indent++;
foreach (var f in backing)
{
code.WriteLine($"result.{f} = BinaryPrimitives.ReverseEndianness(result.{f});");
}
code.Indent--;
code.WriteLine("}");
code.WriteLine();
}
code.WriteLine("return result;");
code.Indent--;
code.WriteLine("}");
code.WriteLine();
code.WriteLine("public readonly byte[] ToArray()");
code.WriteLine("{");
code.Indent++;
code.WriteLine($"var bytes = new byte[Marshal.SizeOf<{structName}>()];");
code.WriteLine("var handle = GCHandle.Alloc(bytes, GCHandleType.Pinned);");
code.WriteLine("Marshal.StructureToPtr(this, handle.AddrOfPinnedObject(), false);");
code.WriteLine("handle.Free();");
if (width > 8)
{
code.WriteLine();
code.WriteLine("if (BitConverter.IsLittleEndian)");
code.WriteLine("{");
code.Indent++;
code.WriteLine($"for (var i = 0; i < MarshalledSize; i += sizeof({ftype}))");
code.WriteLine("{");
code.Indent++;
code.WriteLine($"Array.Reverse(bytes, i, sizeof({ftype}));");
code.Indent--;
code.WriteLine("}");
code.Indent--;
code.WriteLine("}");
code.WriteLine();
}
code.WriteLine("return bytes;");
code.Indent--;
code.WriteLine("}");
code.Indent--;
code.WriteLine("}");
}

View file

@ -0,0 +1,15 @@
var bytes = new byte[Header.MarshalledSize];
Random.Shared.NextBytes(bytes);
var header = Header.FromArray(bytes);
var bytes2 = header.ToArray();
Debug.Assert(Enumerable.SequenceEqual(bytes, bytes2));
Console.WriteLine($"Struct size: {Header.MarshalledSize} bytes");
Console.WriteLine($"Binary data: {string.Join(" ", bytes.Select(b => b.ToString("B8")))}");
Console.WriteLine($"Fields");
foreach (var (fname, fwidth) in fieldList)
{
var value = typeof(Header).GetProperty(fname)!.GetValue(header);
var vstr = $"{value!:B}".PadLeft(fwidth, '0');
Console.WriteLine($" {fname} = {vstr}");
}

View file

@ -0,0 +1,30 @@
proc abbrev s$ .
d$[] = strtok s$ " "
repeat
lng += 1
for i to len d$[] - 1
a$ = substr d$[i] 1 lng
for j = i + 1 to len d$[]
if substr d$[j] 1 lng = a$ : break 2
.
.
until i = len d$[]
.
print lng & ": " & s$
.
repeat
s$ = input
if s$ = ""
print s$
s$ = input
.
until s$ = ""
abbrev s$
.
#
input_data
Sunday Monday Tuesday Wednesday Thursday Friday Saturday
Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag
E_djelë E_hënë E_martë E_mërkurë E_enjte E_premte E_shtunë
Ehud Segno Maksegno Erob Hamus Arbe Kedame
Al_Ahad Al_Ithinin Al_Tholatha'a Al_Arbia'a Al_Kamis Al_Gomia'a Al_Sabit

View file

@ -0,0 +1,17 @@
abbrevs = Hash(String, String).new
" Add ALTer BAckup Bottom CAppend Change SCHANGE CInsert CLAst COMPress COpy
COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
Join SPlit SPLTJOIN LOAD Locate CLocate LOWercase UPPercase LPrefix MACRO
MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD Query QUIT
READ RECover REFRESH RENum REPeat Replace CReplace RESet RESTore RGTLEFT
RIght LEft SAVE SET SHift SI SORT SOS STAck STATus TOP TRAnsfer Type Up
".scan(/([A-Z]+)([a-z]*)/) do |m|
command, minimal_abbrev, extra_letters = m[0].upcase, m[1], m[2].upcase
extra_letters.chars.accumulate(minimal_abbrev).each do |k| abbrevs[k] = command end
end
puts "riG rePEAT copies put mo rest types fup. 6 poweRin".split.map {|w|
abbrevs[w.upcase]? || "*error*"
}.join(" ")

View file

@ -0,0 +1,42 @@
a$ = "Add ALTer BAckup Bottom CAppend Change SCHANGE CInsert CLAst COMPress COpy"
a$ &= " COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find"
a$ &= " NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput"
a$ &= " Join SPlit SPLTJOIN LOAD Locate CLocate LOWercase UPPercase LPrefix MACRO"
a$ &= " MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD Query QUIT"
a$ &= " READ RECover REFRESH RENum REPeat Replace CReplace RESet RESTore RGTLEFT"
a$ &= " RIght LEft SAVE SET SHift SI SORT SOS STAck STATus TOP TRAnsfer Type Up"
cmd$[] = strtok a$ " "
#
func$ toupper s$ .
for c$ in strchars s$
c = strcode c$
if c >= 97 : c -= 32
r$ &= strchar c
.
return r$
.
for i to len cmd$[]
h$ = ""
for c$ in strchars cmd$[i]
if strcode c$ > strcode "Z" : break 1
h$ &= c$
.
abbr$[] &= h$
cmd$[i] = toupper cmd$[i]
.
func$ getabbr in$ .
in$ = toupper in$
for i to len cmd$[]
if strpos cmd$[i] in$ = 1 and strpos in$ abbr$[i] = 1
return cmd$[i]
.
.
return "*error*"
.
in$[] = strtok input " "
for s$ in in$[]
write getabbr s$ & " "
.
#
input_data
riG rePEAT copies put mo rest types fup. 6 poweRin

View file

@ -0,0 +1,42 @@
a$ = "add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3"
a$ &= " compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate"
a$ &= " 3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2"
a$ &= " forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load"
a$ &= " locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2"
a$ &= " msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3"
a$ &= " refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left"
a$ &= " 2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1"
toks$[] = strtok a$ " "
#
func$ toupper s$ .
for c$ in strchars s$
c = strcode c$
if c >= 97 : c -= 32
r$ &= strchar c
.
return r$
.
for tok$ in toks$[]
if number tok$ <> 0
cnt[$] = number tok$
else
cmd$[] &= toupper tok$
cnt[] &= 999
.
.
func$ getabbr in$ .
in$ = toupper in$
for i to len cmd$[]
if cmd$[i] = in$ or len in$ >= cnt[i] and strpos cmd$[i] in$ = 1
return cmd$[i]
.
.
return "*error*"
.
in$[] = strtok input " "
for s$ in in$[]
write getabbr s$ & " "
.
#
input_data
riG rePEAT copies put mo rest types fup. 6 poweRin

View file

@ -1,13 +1,11 @@
proc out s[] . .
proc out s[] .
for r = 0 to 2
for c to 3
write s[c + 3 * r] & " "
.
for c to 3 : write s[c + 3 * r] & " "
print ""
.
print ""
.
proc stab . m[] .
proc stab &m[] .
n = sqrt len m[]
repeat
stable = 1
@ -15,27 +13,17 @@ proc stab . m[] .
if m[p] >= 4
stable = 0
m[p] -= 4
if p > n
m[p - n] += 1
.
if p mod n <> 0
m[p + 1] += 1
.
if p <= len m[] - n
m[p + n] += 1
.
if p mod n <> 1
m[p - 1] += 1
.
if p > n : m[p - n] += 1
if p mod n <> 0 : m[p + 1] += 1
if p <= len m[] - n : m[p + n] += 1
if p mod n <> 1 : m[p - 1] += 1
.
.
until stable = 1
.
.
func[] add s1[] s2[] .
for i to len s1[]
r[] &= s1[i] + s2[i]
.
for i to len s1[] : r[] &= s1[i] + s2[i]
stab r[]
return r[]
.

View file

@ -2,19 +2,18 @@ n = 77
len m[] n * n
m[n * n div 2 + 1] = 10000
#
proc show . .
proc show .
sc = 100 / n
for r range0 n
for c range0 n
move c * sc r * sc
p = r * n + c + 1
color 222 * m[p]
rect sc sc
gcolor 222 * m[p]
grect c * sc r * sc sc sc
.
.
sleep 0
.
proc run . .
proc run .
repeat
mp[] = m[]
stable = 1

View file

@ -0,0 +1,46 @@
import ballerina/io;
function divisors(int n) returns int[] {
if n < 1 { return []; }
int[] divisors = [];
int[] divisors2 = [];
int i = 1;
int k = n % 2 == 0 ? 1 : 2;
while i * i <= n {
if n % i == 0 {
divisors.push(i);
int j = n / i;
if j != i { divisors2.push(j); }
}
i += k;
}
if divisors2.length() > 0 {
divisors.push(...divisors2.reverse());
}
return divisors;
}
function properDivisors(int n) returns int[] {
int[] d = divisors(n);
int c = d.length();
return c <= 1 ? [] : d.slice(0, c - 1);
}
public function main() {
int d = 0;
int a = 0;
int p = 0;
foreach int i in 1...20000 {
int j = int:sum(...properDivisors(i));
if j < i {
d += 1;
} else if j == i {
p += 1;
} else {
a += 1;
}
}
io:println("There are ", d, " deficient numbers between 1 and 20000");
io:println("There are ", a, " abundant numbers between 1 and 20000");
io:println("There are ", p, " perfect numbers between 1 and 20000");
}

View file

@ -0,0 +1,36 @@
import ballerina/io;
public function main() {
final int maxNumber = 20000;
int abundantCount = 0;
int deficientCount = 0;
int perfectCount = 0;
int[] pds = [];
pds.push(0); // element 0
pds.push(0); // element 1
foreach int i in 2...maxNumber {
pds.push(1);
}
foreach int i in 2...maxNumber {
int j = i + i;
while j <= maxNumber {
pds[j] += i;
j += i;
}
}
foreach int n in 1...maxNumber {
int pdSum = pds[n];
if pdSum < n {
deficientCount += 1;
} else if pdSum == n {
perfectCount += 1;
} else { // pdSum > n
abundantCount += 1;
}
}
io:println("Abundant : ", abundantCount);
io:println("Deficient: ", deficientCount);
io:println("Perfect : ", perfectCount);
}

View file

@ -47,5 +47,5 @@ public program()
int deficient := 0;
int perfect := 0;
classifyNumbers(20000, ref abundant, ref deficient, ref perfect);
console.printLine("Abundant: ",abundant,", Deficient: ",deficient,", Perfect: ",perfect)
Console.printLine("Abundant: ",abundant,", Deficient: ",deficient,", Perfect: ",perfect)
}

View file

@ -1,23 +1,51 @@
/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/
parse arg low high . /*obtain optional arguments from the CL*/
high=word(high low 20000,1); low= word(low 1,1) /*obtain the LOW and HIGH values.*/
say center('integers from ' low " to " high, 45, "") /*display a header.*/
!.= 0 /*define all types of sums to zero. */
do j=low to high; $= sigma(j) /*get sigma for an integer in a range. */
if $<j then !.d= !.d + 1 /*Less? It's a deficient number.*/
else if $>j then !.a= !.a + 1 /*Greater? " " abundant " */
else !.p= !.p + 1 /*Equal? " " perfect " */
end /*j*/ /* [↑] IFs are coded as per likelihood*/
/* REXX */
Call time 'R'
cnt.=0
Do x=1 To 20000
pd=proper_divisors(x)
sumpd=sum(pd)
Select
When x<sumpd Then cnt.abundant =cnt.abundant +1
When x=sumpd Then cnt.perfect =cnt.perfect +1
Otherwise cnt.deficient=cnt.deficient+1
End
Select
When npd>hi Then Do
list.npd=x
hi=npd
End
When npd=hi Then
list.hi=list.hi x
Otherwise
Nop
End
End
say ' the number of perfect numbers: ' right(!.p, length(high) )
say ' the number of abundant numbers: ' right(!.a, length(high) )
say ' the number of deficient numbers: ' right(!.d, length(high) )
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure; parse arg x; if x<2 then return 0; odd=x // 2 /* // ◄──remainder.*/
s= 1 /* [↓] only use EVEN or ODD integers.*/
do k=2+odd by 1+odd while k*k<x /*divide by all integers up to √x. */
if x//k==0 then s= s + k + x % k /*add the two divisors to (sigma) sum. */
end /*k*/ /* [↑] % is the REXX integer division*/
if k*k==x then return s + k /*Was X a square? If so, add √ x */
return s /*return (sigma) sum of the divisors. */
Say 'In the range 1 - 20000'
Say format(cnt.abundant ,5) 'numbers are abundant '
Say format(cnt.perfect ,5) 'numbers are perfect '
Say format(cnt.deficient,5) 'numbers are deficient '
Say time('E') 'seconds elapsed'
Exit
proper_divisors: Procedure
Parse Arg n
Pd=''
If n=1 Then Return ''
If n//2=1 Then /* odd number */
delta=2
Else /* even number */
delta=1
Do d=1 To n%2 By delta
If n//d=0 Then
pd=pd d
End
Return space(pd)
sum: Procedure
Parse Arg list
sum=0
Do i=1 To words(list)
sum=sum+word(list,i)
End
Return sum

View file

@ -1,25 +1,30 @@
/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/
parse arg low high . /*obtain optional arguments from the CL*/
high=word(high low 20000,1); low=word(low 1, 1) /*obtain the LOW and HIGH values.*/
say center('integers from ' low " to " high, 45, "") /*display a header.*/
!.= 0 /*define all types of sums to zero. */
do j=low to high; $= sigma(j) /*get sigma for an integer in a range. */
if $<j then !.d= !.d + 1 /*Less? It's a deficient number.*/
else if $>j then !.a= !.a + 1 /*Greater? " " abundant " */
else !.p= !.p + 1 /*Equal? " " perfect " */
end /*j*/ /* [↑] IFs are coded as per likelihood*/
-- 8 May 2025
include Settings
say ' the number of perfect numbers: ' right(!.p, length(high) )
say ' the number of abundant numbers: ' right(!.a, length(high) )
say ' the number of deficient numbers: ' right(!.d, length(high) )
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure; parse arg x 1 z; if x<5 then return max(0, x-1) /*sets X&Z to arg1.*/
q=1; do while q<=z; q= q * 4; end /* ◄──↓ compute integer sqrt of Z (=R)*/
r=0; do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end; end
odd= x//2 /* [↓] only use EVEN | ODD ints. ___*/
s= 1; do k=2+odd by 1+odd to r /*divide by all integers up to √ x */
if x//k==0 then s=s + k + x%k /*add the two divisors to (sigma) sum. */
end /*k*/ /* [↑] % is the REXX integer division*/
if r*r==x then return s - k /*Was X a square? If so, subtract √ x */
return s /*return (sigma) sum of the divisors. */
say 'ABUNDANT, DEFICIENT AND PERFECT NUMBER CLASSIFICATIONS'
say version
say
parse value 0 0 0 with a p d
do x = 1 to 20000
sum = Aliquot(x)
select
when x < sum then
a = a+1
when x = sum then
p = p+1
otherwise
d = d+1
end
end
say 'In the range 1 - 20000'
say Format(a,5) 'numbers are abundant '
say Format(p,5) 'numbers are perfect '
say Format(d,5) 'numbers are deficient '
say Time('e') 'seconds'
exit
include Numbers
include Functions
include Special
include Abend

View file

@ -1,51 +0,0 @@
/* REXX */
Call time 'R'
cnt.=0
Do x=1 To 20000
pd=proper_divisors(x)
sumpd=sum(pd)
Select
When x<sumpd Then cnt.abundant =cnt.abundant +1
When x=sumpd Then cnt.perfect =cnt.perfect +1
Otherwise cnt.deficient=cnt.deficient+1
End
Select
When npd>hi Then Do
list.npd=x
hi=npd
End
When npd=hi Then
list.hi=list.hi x
Otherwise
Nop
End
End
Say 'In the range 1 - 20000'
Say format(cnt.abundant ,5) 'numbers are abundant '
Say format(cnt.perfect ,5) 'numbers are perfect '
Say format(cnt.deficient,5) 'numbers are deficient '
Say time('E') 'seconds elapsed'
Exit
proper_divisors: Procedure
Parse Arg n
Pd=''
If n=1 Then Return ''
If n//2=1 Then /* odd number */
delta=2
Else /* even number */
delta=1
Do d=1 To n%2 By delta
If n//d=0 Then
pd=pd d
End
Return space(pd)
sum: Procedure
Parse Arg list
sum=0
Do i=1 To words(list)
sum=sum+word(list,i)
End
Return sum

View file

@ -1,27 +0,0 @@
/* REXX */
Call time 'R'
cnt.=0
Do x=1 to 20000
sumpd=Sigma(x)-x
Select
When x<sumpd Then do
cnt.abundant =cnt.abundant +1
end
When x=sumpd Then do
cnt.perfect =cnt.perfect +1
end
Otherwise do
cnt.deficient=cnt.deficient+1
end
End
end
Say 'In the range 1 - 20000'
Say format(cnt.abundant ,5) 'numbers are abundant '
Say format(cnt.perfect ,5) 'numbers are perfect '
Say format(cnt.deficient,5) 'numbers are deficient '
Say time('E') 'seconds elapsed'
Exit
include Numbers
include Functions

View file

@ -1,10 +1,10 @@
An [[wp:Abundant_number|Abundant number]] is a number '''n''' for which the &nbsp; ''sum of divisors'' &nbsp; '''σ(n) > 2n''',
<br>or, &nbsp; equivalently, &nbsp; the &nbsp; ''sum of proper divisors'' &nbsp; (or aliquot sum) &nbsp; &nbsp; &nbsp; '''s(n) > n'''.
An [[wp:Abundant_number|Abundant number]] is a number '''n''' for which the &nbsp; ''sum of divisors'' &nbsp; '''<math>\sigma(n) > 2n</math>''',
<br>or, &nbsp; equivalently, &nbsp; the &nbsp; ''sum of proper divisors'' &nbsp; (or aliquot sum) &nbsp; &nbsp; &nbsp; '''<math>s(n) > n</math>'''.
;E.G.:
'''12''' &nbsp; is abundant, it has the proper divisors &nbsp; &nbsp; '''1,2,3,4 <small>&</small> 6''' &nbsp; &nbsp; which sum to &nbsp; '''16''' &nbsp; ( > '''12''' or '''n''');
<br>&nbsp; &nbsp; &nbsp;&nbsp; or alternately, &nbsp; has the sigma sum of &nbsp; '''1,2,3,4,6 <small>&</small> 12''' &nbsp; which sum to &nbsp; '''28''' &nbsp; ( > '''24''' or '''2n''').
'''12''' &nbsp; is abundant, it has the proper divisors &nbsp; &nbsp; '''1, 2, 3, 4 <small>&</small> 6''' &nbsp; &nbsp; which sum to &nbsp; '''16''' &nbsp; ( > '''12''' or '''n''');
<br>&nbsp; &nbsp; &nbsp;&nbsp; or alternately, &nbsp; has the sigma sum of &nbsp; '''1, 2, 3, 4, 6 <small>&</small> 12''' &nbsp; which sum to &nbsp; '''28''' &nbsp; ( > '''24''' or '''2n''').
Abundant numbers are common, though '''even''' abundant numbers seem to be much more common than '''odd''' abundant numbers.
@ -15,7 +15,7 @@ To make things more interesting, this task is specifically about finding &nbsp;
;Task
*Find and display here: at least the first 25 abundant odd numbers and either their proper divisor sum or sigma sum.
*Find and display here: the one thousandth abundant odd number and either its proper divisor sum or sigma sum.
*Find and display here: the first abundant odd number greater than one billion (10<sup>9</sup>) and either its proper divisor sum or sigma sum.
*Find and display here: the first abundant odd number greater than one billion (<math>10^9</math>) and either its proper divisor sum or sigma sum.
;References:

View file

@ -0,0 +1,73 @@
import ballerina/io;
function divisors(int n) returns int[] {
if n < 1 { return []; }
int[] divisors = [];
int[] divisors2 = [];
int i = 1;
int k = n % 2 == 0 ? 1 : 2;
while i * i <= n {
if n % i == 0 {
divisors.push(i);
int j = n / i;
if j != i { divisors2.push(j); }
}
i += k;
}
if divisors2.length() > 0 {
divisors.push(...divisors2.reverse());
}
return divisors;
}
function properDivisors(int n) returns int[] {
int[] d = divisors(n);
int c = d.length();
return c <= 1 ? [] : d.slice(0, c - 1);
}
function sumStr(int[] divs) returns string {
var f = function(string acc, int div) returns string {
return acc + div.toString() + " + ";
};
string sum = divs.reduce(f, "");
int len = sum.length();
return sum.substring(0, len - 3);
}
function abundantOdd(int searchFrom, int countFrom, int countTo, boolean printOne)
returns int {
int count = countFrom;
int n = searchFrom;
while count < countTo {
int[] divs = properDivisors(n);
int tot = int:sum(...divs);
if tot > n {
count += 1;
if !printOne || count >= countTo {
string s = sumStr(divs);
if !printOne {
string s1 = count.toString().padStart(2);
string s2 = n.toString().padStart(5);
io:println(`${s1}. ${s2} < ${s} = ${tot}`);
} else {
io:println(`${n} < ${s} = ${tot}`);
}
}
}
n += 2;
}
return n;
}
public function main() {
final int max = 25;
io:println("The first ", max, " abundant odd numbers are:");
int n = abundantOdd(1, 0, 25, false);
io:println("\nThe one thousandth abundant odd number is:");
_ = abundantOdd(n, 25, 1000, true);
io:println("\nThe first abundant odd number above one billion is:");
_ = abundantOdd(<int>1e9+1, 0, 1, true);
}

View file

@ -14,7 +14,7 @@ fastfunc sumdivs n .
return sum
.
n = 1
numfmt 0 6
numfmt 6 0
while cnt < 1000
sum = sumdivs n
if sum > n

View file

@ -0,0 +1,38 @@
import ballerina/io;
type numeric int|float|decimal;
function accumulator(numeric acc) returns (function(numeric) returns numeric) {
numeric sum = acc;
return function(numeric n) returns numeric {
numeric sum2 = sum;
if sum2 is int && n is int {
sum2 += n;
} else if sum2 is float && n is float {
sum2 += n;
} else if sum2 is decimal && n is decimal {
sum2 += n;
} else if sum2 is int && n is float {
sum2 = <float>sum2 + n;
} else if sum2 is int && n is decimal {
sum2 = <decimal>sum2 + n;
} else if sum2 is float && n is int {
sum2 += <float>n;
} else if sum2 is float && n is decimal {
sum2 = <decimal>sum2 + n;
} else if sum2 is decimal && n is int {
sum2 += <decimal>n;
} else if sum2 is decimal && n is float {
sum2 += <decimal>n;
}
sum = sum2;
return sum;
};
}
public function main() {
var x = accumulator(1);
_ = x(5);
_ = accumulator(2);
io:println(x(2.3));
}

View file

@ -12,5 +12,5 @@ public program()
var y := accumulator(3);
console.write(x(2.3r))
Console.write(x(2.3r))
}

View file

@ -0,0 +1,92 @@
import ballerina/io;
map<byte> pps = {};
function getPerfectPowers(int maxExp) {
int upper = <int>10.0.pow(<float>maxExp);
int upper2 = <int>10.0.pow(<float>maxExp).sqrt().floor();
foreach int i in 2...upper2 {
int p = i;
while true {
if p > int:MAX_VALUE / i { break; }
p *= i;
if p >= upper { break; }
pps[p.toString()] = 1;
}
}
}
function getAchilles(int minExp, int maxExp) returns map<byte> {
int lower = <int>10.0.pow(<float>minExp);
int upper = <int>10.0.pow(<float>maxExp);
int upper2 = <int>10.0.pow(<float>maxExp).cbrt().floor();
int upper3 = <int>10.0.pow(<float>maxExp).sqrt().floor();
map<byte> achilles = {};
foreach int b in 1...upper2 {
int b3 = b * b * b;
foreach int a in 1...upper3 {
int p = b3 * a * a;
if p >= upper { break; }
if p >= lower {
string ps = p.toString();
if !pps.hasKey(ps) {
achilles[ps] = 1;
}
}
}
}
return achilles;
}
function totient(int m) returns int {
if m < 1 { return 0; }
int tot = m;
int n = m;
int i = 2;
while i * i <= n {
if (n % i) == 0 {
while (n % i) == 0 { n /= i; }
tot -= tot / i;
}
if i == 2 { i = 1; }
i += 2;
}
if n > 1 { tot -= tot / n; }
return tot;
}
public function main() returns error? {
final int maxDigits = 14;
getPerfectPowers(maxDigits);
map<byte> achillesSet = getAchilles(1, 5); // enough for first 2 parts
int[] achilles = achillesSet.keys().map(s => check int:fromString(s)).sort();
io:println("First 50 Achilles numbers:");
foreach int i in 0..<50 {
string s = achilles[i].toString().padStart(4);
io:print(s, " ");
if (i + 1) % 10 == 0 { io:println(); }
}
io:println("\nFirst 30 strong Achilles numbers:");
int[] strongAchilles = [];
int count = 0;
int n = 0;
while count < 30 {
int tot = totient(achilles[n]);
if achillesSet.hasKey(tot.toString()) {
strongAchilles.push(achilles[n]);
count += 1;
}
n += 1;
}
foreach int j in 0..<30 {
string t = strongAchilles[j].toString().padStart(5);
io:print(t, " ");
if (j + 1) % 10 == 0 { io:println(); }
}
io:println("\nNumber of Achilles numbers with:");
foreach int d in 2...maxDigits {
int ac = getAchilles(d - 1, d).length();
io:println(d.toString().padStart(2), " digits: ", ac);
}
}

View file

@ -1,14 +1,10 @@
func gcd n d .
if d = 0
return n
.
if d = 0 : return n
return gcd d (n mod d)
.
func totient n .
for m = 1 to n
if gcd m n = 1
tot += 1
.
if gcd m n = 1 : tot += 1
.
return tot
.
@ -16,41 +12,29 @@ func isPowerful m .
n = m
f = 2
l = sqrt m
if m <= 1
return 0
.
if m <= 1 : return 0
while 1 = 1
q = n div f
if n mod f = 0
if m mod (f * f) <> 0
return 0
.
if m mod (f * f) <> 0 : return 0
n = q
if f > n
return 1
.
if f > n : return 1
else
f += 1
if f > l
if m mod (n * n) <> 0
return 0
.
if m mod (n * n) <> 0 : return 0
return 1
.
.
.
.
func isAchilles n .
if isPowerful n = 0
return 0
.
if isPowerful n = 0 : return 0
m = 2
a = m * m
repeat
repeat
if a = n
return 0
.
if a = n : return 0
a *= m
until a > n
.
@ -91,9 +75,7 @@ b = 100
for i = 2 to 5
num = 0
for n = a to b - 1
if isAchilles n = 1
num += 1
.
num += isAchilles n
.
write num & " "
a = b

View file

@ -0,0 +1,14 @@
import ballerina/io;
function ackermann(int m, int n) returns int {
if m == 0 { return n + 1; }
if n == 0 { return ackermann(m - 1, 1); }
return ackermann(m - 1, ackermann(m, n - 1));
}
public function main() {
int[][] pairs = [ [1, 3], [2, 3], [3, 3], [1, 5], [2, 5], [3, 5] ];
foreach var p in pairs {
io:println(`A[${p[0]}, ${p[1]}] = ${ackermann(p[0], p[1])}`);
}
}

View file

@ -1,5 +1,7 @@
import extensions;
// --- Ackermann function ---
ackermann(m,n)
{
if(n < 0 || m < 0)
@ -8,11 +10,11 @@ ackermann(m,n)
};
m =>
0 { ^n + 1 }
! {
0 : { ^n + 1 }
! : {
n =>
0 { ^ackermann(m - 1,1) }
! { ^ackermann(m - 1,ackermann(m,n-1)) }
0 : { ^ackermann(m - 1,1) }
! : { ^ackermann(m - 1,ackermann(m,n-1)) }
}
}
@ -22,9 +24,9 @@ public program()
{
for(int j := 0; j <= 5; j += 1)
{
console.printLine("A(",i,",",j,")=",ackermann(i,j))
Console.printLine("A(",i,",",j,")=",ackermann(i,j))
}
};
console.readChar()
Console.readChar()
}

View file

@ -0,0 +1,23 @@
import ballerina/io;
// Person is an 'open' record type which allows fields of 'anydata' type
// to be added at runtime.
type Person record {
string name;
int age;
};
public function main() {
// Create an instance of Person with an additional 'town' field.
Person p = {
name: "Fred",
age: 40,
"town": "Boston" // extra field name needs to be in quotes
};
// Print name and age fields - using standard '.' syntax.
io:print(p.name, " is ", p.age);
// Print the additional field - using a map-like syntax.
io:println(" and lives in ", p["town"], ".");
}

View file

@ -19,7 +19,7 @@ public program()
object.foo := "bar";
console.printLine(object,".foo=",object.foo);
Console.printLine(object,".foo=",object.foo);
console.readChar()
Console.readChar()
}

View file

@ -0,0 +1,60 @@
begin
integer procedure sumdigits(n);
value n; integer n;
begin
integer q, sum;
sum := 0;
for sum := sum while n > 0 do
begin
q := entier(n / 10);
sum := sum + (n - q * 10);
n := q;
end;
sumdigits := sum;
end;
boolean procedure isprime(n);
value n; integer n;
begin
if n < 2 then
isprime := false
else if n = entier(n / 2) * 2 then
isprime := (n = 2)
else
begin
comment - check odd divisors up to sqrt(n);
integer i, limit;
boolean divisible;
i := 3;
limit := entier(sqrt(n));
divisible := false;
for i := i while i <= limit and not divisible do
begin
if entier(n / i) * i = n then
divisible := true;
i := i + 2
end;
isprime := not divisible;
end;
end;
integer i, count;
outstring(1,"Looking up to 500 for additive primes\n");
count := 0;
for i := 2 step 1 until 500 do
if isprime(i) then
begin
if isprime(sumdigits(i)) then
begin
outinteger(1,i);
count := count + 1;
if count = entier(count / 10) * 10 then
outstring(1,"\n");
end;
end;
outstring(1,"\n");
outinteger(1,count);
outstring(1,"were found\n");
end

View file

@ -0,0 +1,64 @@
BEGIN
% RETURN N MOD M %
INTEGER FUNCTION MOD(N, M);
INTEGER N, M;
BEGIN
MOD := N - (N / M) * M;
END;
% RETURN 1 IF N IS PRIME, OTHERWISE 0 %
INTEGER FUNCTION ISPRIME(N);
INTEGER N;
BEGIN
IF N = 2 THEN
ISPRIME := 1
ELSE IF (N < 2) OR (MOD(N,2) = 0) THEN
ISPRIME := 0
ELSE % TEST ODD DIVISORS UP TO SQRT OF N %
BEGIN
INTEGER I, DIVISIBLE;
I := 3;
DIVISIBLE := 0;
WHILE (I * I <= N) AND (DIVISIBLE = 0) DO
BEGIN
IF MOD(N,I) = 0 THEN DIVISIBLE := 1;
I := I + 2;
END;
ISPRIME := 1 - DIVISIBLE;
END;
END;
% RETURN THE SUM OF THE DIGITS OF N %
INTEGER FUNCTION SUMDIGITS(N);
INTEGER N;
BEGIN
INTEGER SUM;
SUM := 0;
WHILE N > 0 DO
BEGIN
SUM := SUM + MOD(N, 10);
N := N / 10;
END;
SUMDIGITS := SUM;
END;
% LOOK FOR ADDITIVE PRIMES IN RANGE 1 TO 500 %
INTEGER I, S, COUNT;
COUNT := 0;
FOR I := 1 STEP 1 UNTIL 500 DO
BEGIN
IF ISPRIME(I)=1 THEN
BEGIN
S := SUMDIGITS(I);
IF ISPRIME(S)=1 THEN
BEGIN
WRITEON(I);
COUNT := COUNT + 1;
IF MOD(COUNT,8) = 0 THEN WRITE("");
END;
END;
END;
WRITE(COUNT," ADDITIVE PRIMES WERE FOUND");
END

View file

@ -0,0 +1,67 @@
import ballerina/io;
function sumDigits(int m) returns int {
int n = m; // make mutable
int sum = 0;
while n > 0 {
sum += n % 10;
n /= 10;
}
return sum;
}
function isPrime(int n) returns boolean {
if n < 2 { return false; }
if n % 2 == 0 { return n == 2; }
if n % 3 == 0 { return n == 3; }
int d = 5;
while d * d <= n {
if n % d == 0 { return false; }
d += 2;
if n % d == 0 { return false; }
d += 4;
}
return true;
}
function getPrimes(int n) returns int[] {
if n < 2 { return []; }
if n == 2 { return [2]; }
int k = (n - 3) / 2 + 1;
boolean[] marked = [];
marked.setLength(k);
foreach int i in 0..<k { marked[i] = true; }
float f = (<float>n).sqrt().floor();
int lim = (<int>f - 3) / 2 + 1;
foreach int i in 0..<lim {
if marked[i] {
int p = 2 * i + 3;
int s = (p * p - 3) / 2;
int j = s;
while j < k {
marked[j] = false;
j += p;
}
}
}
int[] primes = [2];
foreach int i in 0..<k {
if marked[i] { primes.push(2 * i + 3); }
}
return primes;
}
public function main() {
io:println("Additive primes less than 500:");
int[] primes = getPrimes(499);
int count = 0;
foreach int p in primes {
if isPrime(sumDigits(p)) {
count += 1;
string ps = p.toString().padStart(3);
io:print(ps, " ");
if count % 10 == 0 { io:println(); }
}
}
io:println("\n\n", count, " additive primes found.");
}

View file

@ -1,13 +1,9 @@
func prime n .
if n mod 2 = 0 and n > 2
return 0
.
if n mod 2 = 0 and n > 2 : return 0
i = 3
sq = sqrt n
while i <= sq
if n mod i = 0
return 0
.
if n mod i = 0 : return 0
i += 2
.
return 1
@ -22,9 +18,6 @@ func digsum n .
for i = 2 to 500
if prime i = 1
s = digsum i
if prime s = 1
write i & " "
.
if prime s = 1 : write i & " "
.
.
print ""

View file

@ -0,0 +1,52 @@
additive_primes: procedure options (main);
%replace
search_limit by 500,
true by '1'b,
false by '0'b;
dcl (i, count) fixed bin;
put skip edit('Searching up to ', search_limit,
' for additive primes') (a,f(3),a);
put skip;
count = 0;
do i = 2 to search_limit;
if isprime(i) then
do;
if isprime(sumdigits(i)) then
do;
put edit(i) (f(5));
count = count + 1;
if mod(count,8) = 0 then put skip;
end;
end;
end;
put skip edit(count, ' were found') (f(3), a);
/* return true if n is prime */
isprime: proc(n) returns (bit(1));
dcl
(n, i, limit) fixed bin;
if n < 2 then return (false);
if mod(n, 2) = 0 then return (n = 2);
limit = floor(sqrt(n));
i = 3;
do while ((i <= limit) & (mod(n, i) ^= 0));
i = i + 2;
end;
return (i > limit);
end isprime;
/* return the sum of the digits of n */
sumdigits: proc(n) returns (fixed bin);
dcl
(n, nn, sum) fixed bin;
/* use copy, since n is passed by reference */
nn = n;
sum = 0;
do while (nn > 0);
sum = sum + mod(nn, 10);
nn = nn / 10;
end;
return (sum);
end sumdigits;
end additive_primes;

View file

@ -0,0 +1,4 @@
## uses School;//поиск аддитивных простых чисел
var AdditivePrimes := Primes(500).Where(n -> n.Digits.Sum.IsPrime).ToArray;
Print('Additive Primes:'); AdditivePrimes.Println;
Println('Additive Primes Count:', AdditivePrimes.Count);

View file

@ -1,61 +1,28 @@
-- 22 Mar 2025
include Settings
say version; say 'Additive primes'; say
say 'ADDITIVE PRIMES'
say version
say
arg n
numeric digits 16
if n = '' then
n = -500
n = 500
show = (n > 0); n = Abs(n)
a = Additiveprimes(n)
a = Additives(n)
if show then do
do i = 1 to a
call Charout ,Right(addi.additiveprime.i,8)' '
call Charout ,Right(addi.i,8)' '
if i//10 = 0 then
say
end
say
end
say a 'additive Primes found below' n
say Time('e') 'seconds'
say a 'additive primes found below' n
say Time('e')/1 'seconds'
exit
Additiveprimes:
/* Additive prime numbers */
procedure expose addi. prim.
arg x
/* Init */
addi. = 0
/* Fast values */
if x < 2 then
return 0
if x < 101 then do
a = '2 3 5 7 11 23 29 41 43 47 61 67 83 89 999'
do n = 1 to Words(a)
w = Word(a,n)
if w > x then
leave
addi.additiveprime.n = w
end
n = n-1; addi.0 = n
return n
end
/* Get primes */
p = Primes(x)
/* Collect additive primes */
n = 0
do i = 1 to p
q = prim.Prime.i; s = 0
do j = 1 to Length(q)
s = s+Substr(q,j,1)
end
if Prime(s) then do
n = n+1; addi.additiveprime.n = q
end
end
/* Return number of additive primes */
return n
include Functions
include Numbers
include Sequences
include Numbers
include Functions
include Abend

View file

@ -1,3 +1,3 @@
unit sub MAIN ($limit = 500);
say "{+$_} additive primes < $limit:\n{$_».fmt("%" ~ $limit.chars ~ "d").batch(10).join("\n")}",
with ^$limit .grep: { .is-prime and .comb.sum.is-prime }
with ^$limit .grep: { .is-prime && .comb.sum.is-prime }

View file

@ -0,0 +1,55 @@
$constant true = 0FFFFH
$constant false = 0
$constant limit = 500
function sum.of.digits(n = integer) = integer
var i, sum = integer
var s = string
var ch = char
s = str$(n)
sum = 0
for i = 2 to len(s)
ch = mid(s,i,1)
sum = sum + (ch - '0')
next i
end = sum
function mod(n, m = integer) = integer
end = n - (n / m) * m
comment
build a table of prime numbers using
the classic sieve of Erathosthenes
end
dim integer prime(limit)
var i, j, count = integer
prime(1) = false
for i = 2 to limit
prime(i) = true
next i
rem - strike out multiples of each prime found
for i = 2 to sqr(limit)
if prime(i) then
begin
for j = i + i to limit step i
prime(j) = false
next j
end
next i
rem - use the table for the search
print "Searching up to"; limit; " for additive primes"
count = 0
for i = 2 to limit
if prime(i) then
if prime(sum.of.digits(i)) then
begin
print using "### "; i;
count = count + 1
if mod(count, 10) = 0 then print
end
next i
print
print count;" were found"
end

View file

@ -0,0 +1,29 @@
function isPrime(n: number): boolean {
if (n < 2) return false;
if (n < 4) return true;
if (n % 2 == 0 || n % 3 == 0) return false;
for (let i = 5; i <= n ** 0.5; i += 6) {
if (n % i == 0 || n % (i+2) == 0) return false;
}
return true;
}
function sumDigits(x: number): number {
let sum = 0;
while (x > 0) {
sum = sum + (x % 10);
x = Math.floor(x / 10);
}
return sum;
}
const additivePrimes: number[] = [];
for (let i = 2; i < 10**7; i++) {
if (isPrime(i) && isPrime(sumDigits(i))) {
additivePrimes.push(i);
}
}
console.log(additivePrimes);
console.log(`Found ${additivePrimes.length} values`);

View file

@ -0,0 +1,8 @@
import ballerina/io;
public function main() {
int[] a = [1, 2, 3, 4];
int[] b = [1, 2, 3, 4];
io:println(a == b); // 'true' as values are the same
io:println(a === b); // 'false' as stored at different addresses
}

View file

@ -1,5 +1,5 @@
global width inp$[] .
proc read . .
proc read .
repeat
inp$ = input
until inp$ = ""
@ -12,7 +12,7 @@ proc read . .
.
read
#
proc out mode . .
proc out mode .
for inp$ in inp$[]
ar$[] = strsplit inp$ "$"
for s$ in ar$[]

View file

@ -1,246 +1,129 @@
(defun rob-even-p (integer)
"Test if INTEGER is even."
(= (% integer 2) 0))
(defun prepare-data ()
"Process data into list of lists."
(let ((all-lines)
(processed-line))
(dolist (one-line (split-string "Given$a$text$file$of$many$lines,$where$fields$within$a$line$
are$delineated$by$a$single$'dollar'$character,$write$a$program
that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$
column$are$separated$by$at$least$one$space.
Further,$allow$for$each$word$in$a$column$to$be$either$left$
justified,$right$justified,$or$center$justified$within$its$column." "[\n\r]" :OMIT-NULLS))
(dolist (one-word (split-string one-line "\\$"))
(push one-word processed-line))
(push (nreverse processed-line) all-lines)
(setq processed-line nil))
(nreverse all-lines)))
(defun rob-odd-p (integer)
"Test if INTEGER is odd."
(not (rob-even-p integer)))
(defun get-column (column-number data)
"Get words from COLUMN-NUMBER column in DATA."
(let ((column-result))
(setq column-number (- column-number 1))
(dolist (line data)
(if (nth column-number line)
(push (nth column-number line) column-result)
(push "" column-result)))
column-result))
(defun both-odd-or-both-even-p (x y)
"Test if X and Y are both even or both odd."
(or (and (rob-even-p x) (rob-even-p y))
(and (rob-odd-p x) (rob-odd-p y))))
(defun calc-column-width (column-number data)
"Calculate padded width for COLUMN-NUMBER in DATA."
(let ((column-words (get-column column-number data)))
(+ 2 (apply #'max (mapcar #'length column-words)))))
(defun word-lengths (words)
"Convert WORDS into list of lengths of each word."
(mapcar 'length words))
(defun get-last-column (data)
"Find the last column in DATA."
(apply #'max (mapcar #'length data)))
(defun get-one-row (row-number rows-columns-words)
"Get ROW-NUMBER row from ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
(seq-filter
(lambda (element)
(= row-number (car element)))
rows-columns-words))
(defun get-column-widths (data)
"Get a list of column widths from DATA."
(let ((current-column 1)
(last-column (get-last-column data))
(column-widths))
(while (<= current-column last-column)
(push (calc-column-width current-column data) column-widths)
(setq current-column (1+ current-column)))
(nreverse column-widths)))
(defun get-one-word (row-number column-number rows-columns-words)
"Get one word from ROWS-COLUMNS-WORDS at ROW-NUMBER and COLUMN-NUMBER.
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
(delq nil
(mapcar
(lambda (element)
(when (= column-number (nth 1 element))
(nth 2 element)))
(get-one-row row-number rows-columns-words))))
(defun get-one-column-width (column-number data)
"Get column width of COLUMN-NUMBER from DATA."
(let ((column-widths (get-column-widths data)))
(nth (- column-number 1) column-widths)))
(defun get-last-row (rows-columns-words)
"Get the number of the last row of ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of
row, column, word."
(apply 'max (mapcar 'car rows-columns-words)))
(defun center-align-one-word (word column-width)
"Center align WORD in space of COLUMN-WIDTH."
(let* ((word-width (length word))
(total-padding (- column-width word-width))
(pre-padding-length (/ total-padding 2))
(post-padding-length (- column-width (+ pre-padding-length word-width)))
(pre-padding (make-string pre-padding-length ? ))
(post-padding (make-string post-padding-length ? )))
(insert (format "%s%s%s" pre-padding word post-padding))))
(defun list-nth-column (column rows-columns-words)
"List the words in column COLUMN of ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of row, column,
word."
(let ((row 1)
(column-word)
(last-row (get-last-row rows-columns-words ))
(matches nil))
(while (and (<= row last-row)
(<= column (get-last-column rows-columns-words)))
(setq column-word (get-one-word row column rows-columns-words))
(when (null column-word)
(setq column-word ""))
(push column-word matches)
(setq row (1+ row)))
(flatten-tree (nreverse matches))))
(defun center-align-one-line (one-line column-widths)
"Center align ONE-LINE using COLUMN-WIDTHS."
(let ((word-position 0))
(dolist (word one-line)
(center-align-one-word word (nth word-position column-widths))
(setq word-position (1+ word-position)))))
(defun get-widest-in-column (column)
"Get the widest word in COLUMN, which is a list of words."
(apply #'max (word-lengths column)))
(defun center-align-lines (data)
"Center align columns of words in DATA."
(let ((column-widths (get-column-widths data)))
(dolist (one-line data)
(center-align-one-line one-line column-widths)
(insert (format "%s" "\n")))))
(defun get-column-width (column)
"Calculate the width of COLUMN, which is a list of words."
(+ (get-widest-in-column column) 2))
(defun left-align-one-word (word column-width)
"Left align WORD in space of COLUMN-WIDTH."
(let* ((word-width (length word))
(total-padding (- column-width word-width))
(pre-padding-length 1)
(post-padding-length (- column-width (+ pre-padding-length word-width)))
(pre-padding (make-string pre-padding-length ? ))
(post-padding (make-string post-padding-length ? )))
(insert (format "%s%s%s" pre-padding word post-padding))))
(defun get-column-widths (rows-columns-words)
"Make a list of the column widths in ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is list of lists, with each list in the form of row, column,
word."
(let ((last-column (get-last-column rows-columns-words))
(column 1)
(columns))
(while (<= column last-column)
(push (get-column-width (list-nth-column column rows-columns-words)) columns)
(setq column (1+ column)))
(reverse columns)))
(defun left-align-one-line (one-line column-widths)
"Left align ONE-LINE using COLUMN-WIDTHS."
(let ((word-position 0))
(dolist (word one-line)
(left-align-one-word word (nth word-position column-widths))
(setq word-position (1+ word-position)))))
(defun add-column-widths (widths rows-columns-words)
"Add WIDTHS to ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, with each list in the form of row,
column, word. WIDTHS are the widths of each column. Output is a
list of lists, with each list in the form of column-width, row,
column, word."
(let ((new-data)
(new-database)
(column)
(width))
(dolist (data rows-columns-words)
(setq column (cadr data))
(setq width (nth (- column 1) widths))
(setq new-data (push width data))
(push new-data new-database))
(nreverse new-database)))
(defun left-align-lines (data)
"Left align columns of words in DATA."
(let ((column-widths (get-column-widths data)))
(dolist (one-line data)
(left-align-one-line one-line column-widths)
(insert (format "%s" "\n")))))
(defun get-last-column (rows-columns-words)
"Get the number of the last column in ROWS-COLUMNS-WORDS."
(apply 'max (mapcar 'cadr rows-columns-words)))
(defun right-align-one-word (word column-width)
"Right align WORD in space of COLUMN-WIDTH."
(let* ((word-width (length word))
(total-padding (- column-width word-width))
(post-padding-length 1)
(pre-padding-length (- column-width (+ post-padding-length word-width)))
(pre-padding (make-string pre-padding-length ? ))
(post-padding (make-string post-padding-length ? )))
(insert (format "%s%s%s" pre-padding word post-padding))))
(defun create-rows-columns-words ()
"Put text from column-data.txt file in lists.
Each list consists of a row number, a column number, and a word."
(let ((lines)
(line-number 0)
(word-number)
(words))
(with-temp-buffer
(insert-file-contents "~/Documents/Elisp/column_data.txt")
(beginning-of-buffer)
(dolist (line (split-string (buffer-string) "[\r\n]" :no-nulls))
(push line lines))
(setq lines (nreverse lines)))
(dolist (line lines)
(setq line-number (1+ line-number))
(setq word-number 0)
(dolist (word (split-string line "\\$" :no-nulls))
(setq word-number (1+ word-number))
(push (list line-number word-number word) words)))
(setq words (nreverse words))))
(defun right-align-one-line (one-line column-widths)
"Right align ONE-LINE using COLUMN-WIDTHS."
(let ((word-position 0))
(dolist (word one-line)
(right-align-one-word word (nth word-position column-widths))
(setq word-position (1+ word-position)))))
(defun pad-for-center-align (column-width text)
"Pad TEXT to center in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(total-padding-length (- column-width text-width))
(pre-padding-length)
(post-padding-length)
(pre-padding)
(post-padding))
(if (both-odd-or-both-even-p text-width column-width)
(progn
(setq pre-padding-length (/ total-padding-length 2))
(setq post-padding-length pre-padding-length))
(setq pre-padding-length (+ (/ total-padding-length 2) 1))
(setq post-padding-length (- pre-padding-length 1)))
(setq pre-padding (make-string pre-padding-length ? ))
(setq post-padding (make-string post-padding-length ? ))
(format "%s%s%s" pre-padding text post-padding)))
(defun right-align-lines (data)
"Right align columns of words in DATA."
(let ((column-widths (get-column-widths data)))
(dolist (one-line data)
(right-align-one-line one-line column-widths)
(insert (format "%s" "\n")))))
(defun create-a-center-aligned-line (widths-1row-columns-words)
"Create a centered line based on WIDTHS-1ROW-COLUMNS-WORDS.
WIDTHS-1ROW-COLUMNS-WORDS is a list of lists. Each list consists
of the column-width, the row number, the column number, and the
word. The row number is the same in all lists."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (word-data widths-1row-columns-words)
;; below, nth 0 is the column width, nth 3 is the word
(setq next-section (pad-for-center-align (nth 0 word-data) (nth 3 word-data)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun pad-for-left-align (column-width text)
"Pad TEXT to left-align in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(post-padding-length (- column-width text-width)))
(setq post-padding (make-string post-padding-length ? ))
(format "%s%s" text post-padding)))
(defun create-a-left-aligned-line (widths-1row-columns-words)
"Create a left-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
width, the row number, the column number, and the word. The row
number is the same in every case."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (one-item widths-1row-columns-words)
(setq next-section (pad-for-left-align (nth 0 one-item) (nth 3 one-item)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun pad-for-right-align (column-width text)
"Pad TEXT to right-align in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(pre-padding-length (- column-width text-width)))
(setq pre-padding (make-string pre-padding-length ? ))
(format "%s%s" pre-padding text)))
(defun create-a-right-aligned-line (widths-1row-columns-words)
"Create a right-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
width, the row number, the column number, and the word. The row
number is the same in every case."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (one-item widths-1row-columns-words)
(setq next-section (pad-for-right-align (nth 0 one-item) (nth 3 one-item)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun left-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in left-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-left-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun right-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in right-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-right-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun center-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in center-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-center-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun align-lines (alignment rows-columns-words)
"Write ROWS-COLUMNS-WIDTHS with given ALIGNMENT.
ROWS-COLUMNS-WIDTHS consists of a list of lists. Each internal list contains width of column, row number, column number, and a word."
(defun align-lines (alignment data)
"Write DATA with given ALIGNMENT.
DATA consists of a list of lists. Each internal list conists of a list
of words."
(let ((align-function (pcase alignment
('left 'left-align-lines)
("left" 'left-align-lines)
@ -248,4 +131,4 @@ ROWS-COLUMNS-WIDTHS consists of a list of lists. Each internal list contains wid
("center" 'center-align-lines)
('right 'right-align-lines)
("right" 'right-align-lines))))
(funcall align-function rows-columns-words)))
(funcall align-function data)))

View file

@ -1,7 +1,5 @@
fastfunc sumprop num .
if num = 1
return 0
.
if num = 1 : return 0
sum = 1
root = sqrt num
i = 2
@ -16,60 +14,36 @@ fastfunc sumprop num .
.
return sum
.
func$ tostr ar[] .
for v in ar[]
s$ &= " " & v
.
return s$
.
func$ class k .
oldk = k
newk = sumprop oldk
oldk = newk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "perfect " & tostr seq[]
.
if newk = 0 : return "terminating " & seq[]
if newk = k : return "perfect " & seq[]
newk = sumprop oldk
oldk = newk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "amicable " & tostr seq[]
.
if newk = 0 : return "terminating " & seq[]
if newk = k : return "amicable " & seq[]
for t = 4 to 16
newk = sumprop oldk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "sociable (period " & t - 1 & ") " & tostr seq[]
.
if newk = oldk
return "aspiring " & tostr seq[]
.
if newk = 0 : return "terminating " & seq[]
if newk = k : return "sociable (period " & t - 1 & ") " & seq[]
if newk = oldk : return "aspiring " & seq[]
for i to len seq[] - 1
if newk = seq[i]
return "cyclic (at " & newk & ") " & tostr seq[]
.
.
if newk > 140737488355328
return "non-terminating (term > 140737488355328) " & tostr seq[]
if newk = seq[i] : return "cyclic (at " & newk & ") " & seq[]
.
if newk > 140737488355328 : return "non-terminating (term > 140737488355328) " & seq[]
oldk = newk
.
return "non-terminating (after 16 terms) " & tostr seq[]
return "non-terminating (after 16 terms) " & seq[]
.
print "Number classification sequence"
for j = 1 to 12
print j & " " & class j
print j & ": " & class j
.
for j in [ 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080 ]
print j & " " & class j
print j & ": " & class j
.

View file

@ -1,27 +1,27 @@
The Almkvist-Giullera formula for calculating &nbsp; 1/π<sup>2</sup> &nbsp; is based on the Calabi-Yau
The Almkvist-Giullera formula for calculating <math>\frac{1}{\pi^2}</math> is based on the Calabi-Yau
differential equations of order 4 and 5, &nbsp; which were originally used to describe certain manifolds
in string theory.
The formula is:
::::: <big><big>1/π<sup>2</sup> = (2<sup>5</sup>/3) &sum;<sub>0</sub><sup>∞</sup> ((6n)! / (n!<sup>6</sup>))(532n<sup>2</sup> + 126n + 9) / 1000<sup>2n+1</sup></big></big>
:<math>\frac{1}{\pi^{2}}=32 \sum_{n=0}^{\infty}\frac{(6n)!}{3 \cdot n!^{6}}(532n^{2}+126n+9)\frac{1}{10^{6n+3}}</math>
This formula can be used to calculate the constant &nbsp; <big>π<sup>-2</sup></big>, &nbsp; and thus to calculate &nbsp; <big>π</big>.
This formula can be used to calculate the constant <math>\frac{1}{\pi^2}</math>, &nbsp; and thus to calculate <math>\pi</math>.
Note that, because the product of all terms but the power of 1000 can be calculated as an integer,
the terms in the series can be separated into a large integer term:
::::: <big> (2<sup>5</sup>) (6n)! (532n<sup>2</sup> + 126n + 9) / (3(n!)<sup>6</sup>) </big> &nbsp;&nbsp;&nbsp; (***)
:<math>\frac{32(6n)!}{3 \cdot n!^{6}}(532n^{2}+126n+9)</math>
multiplied by a negative integer power of 10:
::::: <big> 10<sup>-(6n + 3)</sup> </big>
:<math>10^{-(6n + 3)}</math>
;Task:
:* Print the integer portions (the starred formula, which is without the power of 1000 divisor) of the first 10 terms of the series.
:* Use the complete formula to calculate and print <big>π</big> to 70 decimal digits of precision.
:* Use the complete formula to calculate and print <math>\pi</math> to 70 decimal digits of precision.
;Reference:

View file

@ -7,7 +7,7 @@ A &nbsp; [[wp:Almost prime|k-Almost-prime]] &nbsp; is a natural number &nbsp; <m
;Task:
Write a function/method/subroutine/... that generates k-almost primes and use it to create a table here of the first ten members of k-Almost primes for &nbsp; <math>1 <= K <= 5</math>.
Write a function/method/subroutine/... that generates k-almost primes and use it to create a table here of the first ten members of k-Almost primes for &nbsp; <math>1 \le K \le 5</math>.
;Related tasks:

View file

@ -0,0 +1,32 @@
import ballerina/io;
function kPrime(int m, int k) returns boolean {
int n = m; // make mutable
int nf = 0;
foreach int i in 2...n {
while (n % i) == 0 {
if nf == k { return false; }
nf += 1;
n /= i;
}
}
return nf == k;
}
function gen(int k, int m) returns int[] {
int[] r = [];
r.setLength(m);
int n = 2;
foreach int i in 0 ..< r.length() {
while !kPrime(n, k) { n += 1; }
r[i] = n;
n += 1;
}
return r;
}
public function main() {
foreach int k in 1...5 {
io:println(k, " ", gen(k, 10));
}
}

View file

@ -19,5 +19,3 @@
(println (for [k (range 1 6)]
(println "k:" k (divisors-k k 10))))
}

View file

@ -2,27 +2,23 @@ func kprime n k .
i = 2
while i <= n
while n mod i = 0
if f = k
return 0
.
if f = k : return 0
f += 1
n /= i
.
i += 1
.
if f = k
return 1
.
if f = k : return 1
return 0
.
for k = 1 to 5
write "k=" & k & " : "
i = 2
c = 0
while c < 10
cnt = 0
while cnt < 10
if kprime i k = 1
write i & " "
c += 1
cnt += 1
.
i += 1
.

View file

@ -0,0 +1,38 @@
: multiplicity ( n1 n2 -- n1 n2 n3 )
0 >r
begin
2dup mod 0=
while
r> 1+ >r
tuck / swap
repeat
r> ;
: k-prime? ( n k -- ? )
>r 0 >r 2
begin
2dup dup * >= if 2r@ > else false then
while
multiplicity r> + >r 1+
repeat
drop
1 > if 1 else 0 then r> + r> = ;
: next-k-prime ( n k -- n )
begin
swap 1+ swap
2dup k-prime?
until drop ;
: main
6 1 do
." k = " i 1 .r ." :"
1 10 0 do
j next-k-prime
dup 3 .r space
loop
drop cr
loop ;
main
bye

View file

@ -1,35 +0,0 @@
/*REXX program computes and displays the first N K─almost primes from 1 ──► K. */
parse arg N K . /*get optional arguments from the C.L. */
if N=='' | N=="," then N=10 /*N not specified? Then use default.*/
if K=='' | K=="," then K= 5 /*K " " " " " */
/*W: is the width of K, used for output*/
do m=1 for K; $=2**m; fir=$ /*generate & assign 1st K─almost prime.*/
#=1; if #==N then leave /*#: K─almost primes; Enough are found?*/
#=2; $=$ 3*(2**(m-1)) /*generate & append 2nd K─almost prime.*/
if #==N then leave /*#: K─almost primes; Enough are found?*/
if m==1 then _=fir + fir /* [↓] gen & append 3rd K─almost prime*/
else do; _=9 * (2**(m-2)); #=3; $=$ _; end
do j=_ + m - 1 until #==N /*process an K─almost prime N times.*/
if factr()\==m then iterate /*not the correct K─almost prime? */
#=# + 1; $=$ j /*bump K─almost counter; append it to $*/
end /*j*/ /* [↑] generate N K─almost primes.*/
say right(m, length(K))"─almost ("N') primes:' $
end /*m*/ /* [↑] display a line for each K─prime*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
factr: z=j; do f=0 while z// 2==0; z=z% 2; end /*divisible by 2.*/
do f=f while z// 3==0; z=z% 3; end /*divisible " 3.*/
do f=f while z// 5==0; z=z% 5; end /*divisible " 5.*/
do f=f while z// 7==0; z=z% 7; end /*divisible " 7.*/
do f=f while z//11==0; z=z%11; end /*divisible " 11.*/
do f=f while z//13==0; z=z%13; end /*divisible " 13.*/
do p=17 by 6 while p<=z /*insure P isn't divisible by three. */
parse var p '' -1 _ /*obtain the right─most decimal digit. */
/* [↓] fast check for divisible by 5. */
if _\==5 then do; do f=f+1 while z//p==0; z=z%p; end; f=f-1; end /*÷ by P? */
if _ ==3 then iterate /*fast check for X divisible by five.*/
x=p+2; do f=f+1 while z//x==0; z=z%x; end; f=f-1 /*÷ by X? */
end /*i*/ /* [↑] find all the factors in Z. */
if f==0 then return 1 /*if prime (f==0), then return unity.*/
return f /*return to invoker the number of divs.*/

View file

@ -1,66 +0,0 @@
/*REXX program computes and displays the first N K─almost primes from 1 ──► K. */
parse arg N K . /*obtain optional arguments from the CL*/
if N=='' | N==',' then N=10 /*N not specified? Then use default.*/
if K=='' | K==',' then K= 5 /*K " " " " " */
nn=N; N=abs(N); w=length(K) /*N positive? Then show K─almost primes*/
limit= (2**K) * N / 2 /*this is the limit for most K-primes. */
if N==1 then limit=limit * 2 /* " " " " " a N of 1.*/
if K==1 then limit=limit * 4 /* " " " " " a K─prime " 2.*/
if K==2 then limit=limit * 2 /* " " " " " " " " 4.*/
if K==3 then limit=limit * 3 % 2 /* " " " " " " " " 8.*/
call genPrimes limit + 1 /*generate primes up to the LIMIT + 1.*/
say 'The highest prime computed: ' @.# " (under the limit of " limit').'
say /* [↓] define where 1st K─prime is odd*/
d.=0; d.2= 2; d.3 = 4; d.4 = 7; d.5 = 13; d.6 = 22; d.7 = 38; d.8=63
d.9=102; d.10=168; d.11=268; d.12=426; d.13=673; d.14=1064
d!=0
do m=1 for K; d!=max(d!,d.m) /*generate & assign 1st K─almost prime.*/
mr=right(m,w); mm=m-1
$=; do #=1 to min(N, d!) /*assign some doubled K─almost primes. */
$=$ d.mm.# * 2
end /*#*/
#=#-1
if m==1 then from=2
else from=1 + word($, words($) )
do j=from until #==N /*process an K─almost prime N times.*/
if factr()\==m then iterate /*not the correct K─almost prime? */
#=#+1; $=$ j /*bump K─almost counter; append it to $*/
end /*j*/ /* [↑] generate N K─almost primes.*/
if nn>0 then say mr"─almost ("N') primes:' $
else say ' the last' mr "K─almost prime: " word($, words($))
/* [↓] assign K─almost primes.*/
do q=1 for #; d.m.q=word($,q) ; end /*q*/
do q=1 for #; if d.m.q\==d.mm.q*2 then leave; end /*q*/
/* [↑] count doubly-duplicates*/
/*──── say copies('─',40) 'for ' m", " q-1 'numbers were doubly─duplicated.' ────*/
/*──── say ────*/
end /*m*/ /* [↑] display a line for each K─prime*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
factr: if #.j\==. then return #.j
z=j; do f=0 while z// 2==0; z=z% 2; end /*÷ by 2*/
do f=f while z// 3==0; z=z% 3; end /*÷ " 3*/
do f=f while z// 5==0; z=z% 5; end /*÷ " 5*/
do f=f while z// 7==0; z=z% 7; end /*÷ " 7*/
do f=f while z//11==0; z=z%11; end /*÷ " 11*/
do f=f while z//13==0; z=z%13; end /*÷ " 13*/
do f=f while z//17==0; z=z%17; end /*÷ " 17*/
do f=f while z//19==0; z=z%19; end /*÷ " 19*/
do i=9 while @.i<=z; d=@.i /*divide by some higher primes. */
do f=f while z//d==0; z=z%d; end /*is Z divisible by the prime D ? */
end /*i*/ /* [↑] find all factors in Z. */
if f==0 then f=1; #.j=f; return f /*Is prime (f≡0)? Then return unity. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
genPrimes: arg x; @.=; @.1=2; @.2=3; #.=.; #=2; s.#=@.#**2
do j=@.# +2 by 2 to x /*only find odd primes from here on. */
do p=2 while s.p<=j /*divide by some known low odd primes. */
if j//@.p==0 then iterate j /*Is J divisible by X? Then ¬ prime.*/
end /*p*/ /* [↓] a prime (J) has been found. */
#=#+1; @.#=j; #.j=1; s.#=j*j /*bump prime count, and also assign ···*/
end /*j*/ /* ··· the # of factors, prime, prime².*/
return /* [↑] not an optimal prime generator.*/

View file

@ -1,6 +1,8 @@
include Settings
say version; say 'k-Almost primes'; say
say 'ALMOST PRIME - 3 Mar 2025'
say version
say
arg n k m
say 'Direct approach using Factors'
numeric digits 16

Some files were not shown because too many files have changed in this diff Show more