Data update

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

View file

@ -0,0 +1,37 @@
with Ada.Text_Io;
with Ada.Integer_text_IO;
procedure Call_Back_Example is
-- Purpose: Apply a callback to an array
-- Output: Prints the squares of an integer array to the console
-- Define the callback procedure
procedure Display(Location : Positive; Value : Integer) is
begin
Ada.Text_Io.Put("array(");
Ada.Integer_Text_Io.Put(Item => Location, Width => 1);
Ada.Text_Io.Put(") = ");
Ada.Integer_Text_Io.Put(Item => Value * Value, Width => 1);
Ada.Text_Io.New_Line;
end Display;
-- Define an access type matching the signature of the callback procedure
type Call_Back_Access is access procedure(L : Positive; V : Integer);
-- Define an unconstrained array type
type Value_Array is array(Positive range <>) of Integer;
-- Define the procedure performing the callback
procedure Map(Values : Value_Array; Worker : Call_Back_Access) is
begin
for I in Values'range loop
Worker(I, Values(I));
end loop;
end Map;
-- Define and initialize the actual array
Sample : Value_Array := (5,4,3,2,1);
begin
Map(Sample, Display'access);
end Call_Back_Example;

View file

@ -0,0 +1,13 @@
pragma Ada_2022;
with Ada.Text_IO; use Ada.Text_IO;
procedure Array_Callback is
type Integer_Array is array (Positive range <>) of Integer;
A : constant Integer_Array := (for I in 1..10 => I);
B : constant Integer_Array := (for I in A'Range => A (I) ** 2);
begin
for I in B'Range loop
Put (B (I)'Image);
end loop;
New_Line;
end Array_Callback;

View file

@ -0,0 +1,13 @@
( (square=.!arg^2)
& 1 3 5 7:?numbers
& map$(square.!numbers):?squares2a { functional form }
& out$!squares2a
& map$((=.!arg^2).!numbers):?squares2b { functional form with `lambda` }
& out$!squares2b
& :?isquares1
& whl
' ( !numbers:#%?number ?numbers
& !isquares1 !number^2:?isquares1
)
& out$!isquares1
);

View file

@ -0,0 +1,22 @@
( (square=.!arg^2)
& (1,3,5,7):?numbers
& mop
$ (square.!numbers.(=,).(=,))
: ?squares2a
& out$!squares2a
& mop
$ ( (=.!arg^2)
. !numbers
. (=,)
. (=,)
)
: ?squares2b
& out$!squares2b
& :?isquares1
& whl
' ( !numbers:(?number,?numbers)
& (!isquares1,!number^2):?isquares1
)
& (!isquares1,!numbers^2):(,?isquares1)
& out$!isquares1
);

View file

@ -0,0 +1,29 @@
( ( callbackFunction1
= location value
. !arg:(?location,?value)
& out$(str$(array[ !location "] = " !!value))
)
& ( callbackFunction2
= location value
. !arg:(?location,?value)
& !!value^2:?!value
)
& ( mapar
= arr len callback i
. !arg:(?arr,?len,?callback)
& 0:?i
& whl
' ( !i:<!len
& !callback$(!i,!i$!arr)
& 1+!i:?i
)
)
& tbl$(array,4)
& 1:?(0$array)
& 2:?(1$array)
& 3:?(2$array)
& 4:?(3$array)
& mapar$(array,4,callbackFunction1)
& mapar$(array,4,callbackFunction2)
& mapar$(array,4,callbackFunction1)
);

View file

@ -0,0 +1,20 @@
>>SOURCE FORMAT IS FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. map.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 i USAGE IS INDEX.
01 table-size CONSTANT AS 30.
LINKAGE SECTION.
01 table-param.
03 table-values USAGE IS FLOAT-LONG, OCCURS table-size TIMES.
01 func-ptr USAGE IS PROGRAM-POINTER.
PROCEDURE DIVISION USING BY REFERENCE table-param, BY VALUE func-ptr.
PERFORM VARYING i FROM 1 BY 1 UNTIL i IS GREATER THAN table-size
CALL func-ptr USING BY REFERENCE table-values(i)
END-PERFORM
GOBACK.
END PROGRAM map.

View file

@ -0,0 +1,18 @@
function apply_to_all(sequence s, integer f)
-- apply a function to all elements of a sequence
sequence result
result = {}
for i = 1 to length(s) do
-- we can call add1() here although it comes later in the program
result = append(result, call_func(f, {s[i]}))
end for
return result
end function
function add1(atom x)
return x + 1
end function
-- add1() is visible here, so we can ask for its routine id
? apply_to_all({1, 2, 3}, routine_id("add1"))
-- displays {2,3,4}

View file

@ -0,0 +1,7 @@
import gleam/list
pub fn main() {
[1, 14, 99, 23]
|> list.map(fn(x) { x * 2 })
|> echo
}

View file

@ -0,0 +1,10 @@
class Main {
static function main() {
var numbers = [1, 2, 3, 4, 5];
var squared = (i) -> i * i;
trace(numbers);
trace(numbers.map(squared));
}
}

View file

@ -0,0 +1,2 @@
; apply an interpolated string closure
(map #"{%} + 1 = {+ 1 %}" [1 2 3 4])

View file

@ -0,0 +1 @@
println [1,2,3,4,5].map{ n -> n * n }

View file

@ -0,0 +1 @@
[1, 4, 9, 16, 25]

View file

@ -0,0 +1 @@
println [1,2,3,4,5].map{ it * it }

View file

@ -0,0 +1 @@
println [[1,2],[2,3],[3,4],[4,5]].map{ a,b -> a * b }

View file

@ -0,0 +1 @@
[2, 6, 12, 20]

View file

@ -0,0 +1,8 @@
import "listUtil"
sq = function (x)
return x * x
end function
arr = range(1, 10)
arr.apply(@sq)
print(arr)

View file

@ -0,0 +1 @@
1..5 | ForEach-Object { $_ * $_ }

View file

@ -0,0 +1,4 @@
function map ([array] $a, [scriptblock] $s) {
$a | ForEach-Object $s
}
map (1..5) { $_ * $_ }

View file

@ -1,52 +1,38 @@
-- 8 Sep 2025
-- 31 Mar 2026
include Setting
numeric digits 4
say 'APPLY A CALLBACK TO AN ARRAY'
say version
say
call Task 'x'
call Task ''
call Task 'Sqrt(x)'
call Task 'Sin(x)'
call Task 'Exp(x)'
say 'Generate...'
call Struct2stem 'stem.','1 2 3 4 5 6 7 8 9 10'
call ShowSt 'stem.','1 to 10 ascending',,7
call CopySt 'stem.','copy.'
say 'Single function Square'
call MapSt 'stem.','square'
call ShowSt 'stem.','after square',,7
say 'Your own function Cubic...'
call CopySt 'copy.','stem.'
call MapSt 'stem.','cube'
call ShowSt 'stem.','after cube',,7
say 'Expression x^2+2x+3...'
call CopySt 'copy.','stem.'
call MapSt 'stem.','x**2+2*x+3'
call ShowSt 'stem.','after simple formula',,7
say 'Expression Sin(x)+Square(x)...'
call CopySt 'copy.','stem.'
call MapSt 'stem.','sin(x)+square(x)'
call ShowSt 'stem.','after more involved formula',,7
exit
Task:
-- Get function to apply
parse arg function
-- Example array with x-values
array.=0; n=10
do i = 1 to n
array.i=i
end
array.0 = n
if function = '' then do
-- Apply fixed function to each element
do i = 1 to array.0
array.i=Square(array.i)
end
function='Square(x)'
end
else do
-- Apply dynamic function to each element
do i = 1 to array.0
array.i=Std(Eval(function,array.i)/1)
end
end
-- Show after callback
call Show
return
Show:
say ' x' function
do i = 1 to n
say Right(i,2) array.i
end
say
return
Square:
Cubic:
arg xx
return xx**2
return xx**3
-- MapSt; Struct2stem; ShowSt; CopySt; Square; Sin
include Math

View file

@ -0,0 +1,26 @@
Rebol [
Title: "Array Callback"
URL: http://rosettacode.org/wiki/Apply_a_callback_to_an_Array
]
map: func [
"Apply a function across an array."
f [native! function!] "Function to apply to each element of array."
a [block!] "Array to process."
/local x
][x: copy [] forall a [append x do [f a/1]] x]
square: func [x][x * x]
; Tests:
assert: func [code][print [either do code [" ok"]["FAIL"] mold code]]
print "Simple loop, modify in place:"
assert [[1 100 81] = (a: [1 10 9] forall a [a/1: square a/1] a)]
print [crlf "Functional style with 'map':"]
assert [[4 16 36] = map :square [2 4 6]]
print [crlf "Applying native function with 'map':"]
assert [[2 4 6] = map :square-root [4 16 36]]

View file

@ -5,5 +5,5 @@ fn echo(n: &i32) {
fn main() {
let a: [i32; 5];
a = [1, 2, 3, 4, 5];
let _: Vec<_> = a.into_iter().map(echo).collect();
let _: Vec<_> = a.iter().map(echo).collect();
}

View file

@ -0,0 +1,32 @@
// avoid executing function definitions
GOTO body
// our function to apply
funcsquare
x * x
return
lblbody
// add some values to the memory buffer
set 256 1
set 257 2
set 258 3
set 259 4
set 260 5
// i is our array pointer
// in sil it's customary to place data in cells > 255
// to avoid interference with ascii variables
i = 256
lblloop
// place value at i where square function expects it
x = get i
// call square function
GOSUB square
printInt x
// increment pointer; this is like i += 1 in C
i + 1
a = 261 - i
// start another iteration if we are below cell 261
if a loop

View file

@ -0,0 +1 @@
⍚&p⇡10

View file

@ -0,0 +1,16 @@
class callback
dim sRule
public property let rule( x )
sRule = x
end property
public default function applyTo(a)
dim p1
for i = lbound( a ) to ubound( a )
p1 = a( i )
a( i ) = eval( sRule )
next
applyTo = a
end function
end class

View file

@ -0,0 +1,13 @@
dim a1
dim cb
set cb = new callback
cb.rule = "ucase(p1)"
a1 = split("my dog has fleas", " " )
cb.applyTo a1
wscript.echo join( a1, " " )
cb.rule = "p1 ^ p1"
a1 = array(1,2,3,4,5,6,7,8,9,10)
cb.applyto a1
wscript.echo join( a1, ", " )