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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2023-09-01 09:35:06 -07:00
parent 61b93a2cd1
commit 5af6d93694
858 changed files with 20572 additions and 2082 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Task/100-doors/ALGOL-68/100-doors-1.alg
View file

@ -1,7 +1,4 @@
# declare some constants #
INT limit = 100;
PROC doors = VOID:
PROC doors = (INT limit)VOID:
(
MODE DOORSTATE = BOOL;
BOOL closed = FALSE;
@ -12,14 +9,12 @@ PROC doors = VOID:
FOR i FROM LWB the doors TO UPB the doors DO the doors[i]:=closed OD;
FOR i FROM LWB the doors TO UPB the doors DO
FOR j FROM LWB the doors TO UPB the doors DO
IF j MOD i = 0 THEN
the doors[j] := NOT the doors[j]
FI
FOR j FROM LWB the doors BY i TO UPB the doors DO
the doors[j] := NOT the doors[j]
OD
OD;
FOR i FROM LWB the doors TO UPB the doors DO
printf(($g" is "gl$,i,(the doors[i]|"opened"|"closed")))
print((whole(i,-12)," is ",(the doors[i]|"opened"|"closed"),newline))
OD
);
doors;
doors(100)

23
Task/100-doors/Koka/100-doors-1.koka Normal file
View file

@ -0,0 +1,23 @@
type state
Open
Closed
fun toggle(self: state): state
match self
Open -> Closed
Closed -> Open
inline extern unsafe-assign : forall<a> ( v : vector<a>, i : ssize_t, x : a ) -> total ()
c "kk_vector_unsafe_assign"
fun main()
val doors = vector(100, Closed)
for(0,99) fn(pass)
var door := pass
while { door < 99 }
doors.unsafe-assign(door.ssize_t, doors[door].toggle)
door := door + (pass+1)
doors.foreach-indexed fn(idx, it)
match it
Open -> println("door " ++ (idx + 1).show ++ " is open")
Closed -> println("door " ++ (idx + 1).show ++ " is closed")

9
Task/100-doors/Koka/100-doors-2.koka Normal file
View file

@ -0,0 +1,9 @@
fun main()
val doors = list(0,99,1,fn(i) Closed)
val transformed = list(1,99).foldl(doors) fn(drs, pass)
drs.map-indexed fn(i, door)
if ((i + 1) % pass) == 0 then door.toggle else door
transformed.foreach-indexed fn(idx, it)
match it
Open -> println("door " ++ (idx + 1).show ++ " is open")
Closed -> println("door " ++ (idx + 1).show ++ " is closed")

8
Task/100-doors/MATLAB/100-doors-3.m
View file

@ -1,5 +1,5 @@
a = zeros(100,1);
for counter = 1:sqrt(100);
a(counter^2) = 1;
doors = zeros(1,100); // 0: closed 1: open
for i = 1:100
doors(i:i:100) = 1-doors(i:i:100)
end
a
doors

18
Task/100-doors/MATLAB/100-doors-4.m
View file

@ -1,15 +1,5 @@
function [doors,opened,closed] = hundredDoors()
%Initialize the doors, make them booleans for easy vectorization
doors = logical( (1:1:100) );
%Go through the flipping process, ignore the 1 case because the doors
%array is already initialized to all open
for initialPosition = (2:100)
doors(initialPosition:initialPosition:100) = not( doors(initialPosition:initialPosition:100) );
end
opened = find(doors); %Stores the numbers of the open doors
closed = find( not(doors) ); %Stores the numbers of the closed doors
a = zeros(100,1);
for counter = 1:sqrt(100);
a(counter^2) = 1;
end
a

16
Task/100-doors/MATLAB/100-doors-5.m
View file

@ -1,3 +1,15 @@
doors((1:10).^2) = 1;
function [doors,opened,closed] = hundredDoors()
doors
%Initialize the doors, make them booleans for easy vectorization
doors = logical( (1:1:100) );
%Go through the flipping process, ignore the 1 case because the doors
%array is already initialized to all open
for initialPosition = (2:100)
doors(initialPosition:initialPosition:100) = not( doors(initialPosition:initialPosition:100) );
end
opened = find(doors); %Stores the numbers of the open doors
closed = find( not(doors) ); %Stores the numbers of the closed doors
end

3
Task/100-doors/MATLAB/100-doors-6.m Normal file
View file

@ -0,0 +1,3 @@
doors((1:10).^2) = 1;
doors

90
Task/100-prisoners/Koka/100-prisoners.koka Normal file
View file

@ -0,0 +1,90 @@
import std/num/random
value struct drawer
num: int
open: bool = False
inline extern unsafe-assign : forall<a> ( v : vector<a>, i : ssize_t, x : a ) -> total ()
c "kk_vector_unsafe_assign"
fun createDrawers()
val drawers = vector(100, Drawer(0,open=True))
for(0, 99) fn(i)
var found := False
while {!found}
val r = random-int() % 100
if drawers[r].open then
drawers.unsafe-assign(r.ssize_t, Drawer(i))
found := True
else
()
drawers
fun closeAll(d:vector<drawer>)
for(0,99) fn(i)
d.unsafe-assign(i.ssize_t, d[i](open=False))
effect fail
final ctl failed(): a
fun open-random(drawers: vector<drawer>)
val r = random-int() % 100
val opened = drawers[r]
if opened.open then
open-random(drawers)
else
drawers.unsafe-assign(r.ssize_t, opened(open=True))
opened.num
fun random-approach(drawers: vector<drawer>)
for(0, 99) fn(i)
var found := False
for(0, 49) fn(j)
val opened = open-random(drawers)
if opened == i then
found := True
else
()
if !found then
failed()
else
drawers.closeAll()
fun optimal-approach(drawers: vector<drawer>)
for(0, 99) fn(i)
var found := False
var drawer := i;
for(0, 49) fn(j)
val opened = drawers[drawer]
if opened.open then
failed()
if opened.num == i then
found := True
else
drawers.unsafe-assign(drawer.ssize_t, opened(open=True))
drawer := opened.num
if !found then
failed()
else
drawers.closeAll()
()
fun run-trials(f, num-trials)
var num_success := 0
for(0,num-trials - 1) fn(i)
val drawers = createDrawers()
with handler
return(x) ->
num_success := num_success + 1
final ctl failed() ->
()
f(drawers)
num_success
fun main()
val num_trials = 1000
val num_success_random = run-trials(random-approach, num_trials)
val num_success_optimal = run-trials(optimal-approach, num_trials)
println("Number of trials: " ++ num_trials.show)
println("Random approach: wins " ++ num_success_random.show ++ " (" ++ (num_success_random.float64 * 100.0 / num_trials.float64).show(2) ++ "%)")
println("Optimal approach: wins " ++ num_success_optimal.show ++ " (" ++ (num_success_optimal.float64 * 100.0 / num_trials.float64).show(2) ++ "%)")

100
Task/15-puzzle-game/Koka/15-puzzle-game.koka Normal file
View file

@ -0,0 +1,100 @@
import std/num/random
import std/os/readline
struct board
cells: vector<vector<int>>
hole-pos: (int, int)
size: (int, int)
type move
MUp
MDown
MLeft
MRight
fun delta(move: move): (int, int)
match move
MUp -> (0, 1)
MDown -> (0, -1)
MLeft -> (1, 0)
MRight -> (-1, 0)
inline extern unsafe-assign : forall<a> ( v : vector<a>, i : ssize_t, x : a ) -> total ()
c "kk_vector_unsafe_assign"
fun update(game: board, move: move): exn board
val (dx, dy) = move.delta
val (hx, hy) = game.hole-pos
val (nx, ny) = (hx + dx, hy + dy)
val (w, h) = game.size
if nx >= 0 && nx < w && ny >= 0 && ny < h then
game.cells[hx].unsafe-assign(hy.ssize_t, game.cells[nx][ny])
game.cells[nx].unsafe-assign(ny.ssize_t, 0)
game(hole-pos=(nx, ny))
else
game
val num_shuffles = 100
fun random-move(): random move
match random-int() % 4
0 -> MUp
1 -> MDown
2 -> MLeft
_ -> MRight
fun setup(size: (int, int)): <exn,random> board
val (w, h) = size
val cells = vector-init(w, fn(x) vector-init(h, fn(y) x*h + y + 1))
var game := Board(cells, (w - 1, h - 1), size)
for(0,num_shuffles) fn(_)
game := game.update(random-move())
game
effect break<a>
final ctl break(a: a) : b
fun finished(game: board): exn bool
val (w, h) = game.size
var i := 1
with final ctl break(a:bool)
a
for(0,w - 1) fn(x)
for(0,h - 1) fn(y)
if game.cells[x][y] != i then
break(False)
else
i := i + 1
True
fun display(game: board): <console,exn> ()
println("")
val (w, h) = game.size
for(0, h - 1) fn(y)
for(0, w - 1) fn(x)
val c = game.cells[x][y]
if c == 0 then
print(" ")
else
print(" " ++ c.show ++ " ")
println("")
println("")
fun get_move(): <div,console,exn,break<string>> move
val c = readline()
match c.trim()
"w" -> MUp
"s" -> MDown
"a" -> MLeft
"d" -> MRight
"q" -> break("Finished")
_ -> get_move()
fun main()
var game := setup((4, 4))
with final ctl break(a:string)
a.println
while {!game.finished}
game.display
val move = get_move()
game := game.update(move)
println("You won!")

104
Task/21-game/Fortran/21-game-3.f Normal file
View file

@ -0,0 +1,104 @@
begin globals
begin enum 1
_btn1
_btn2
_btn3
_sum
_msg
_popup
_skill
_human = 0
_robot
end enum
str15 cr : cr = chr$(13)
str255 string(1) : short who = _human
byte best(3), sum, num, skill = 1 //Medium skill
poke int @best(0), 33751297 //Initialize computer responses
end globals
local fn buildWindow
subclass window 1, @"21 Game in FutureBasic" , ( 0, 0,640,200 )
popupbutton _popup,, 1, @"Minimum;Medium;Maximum" , ( 80, 17,100, 32 )
textlabel _msg , @"Original code: J. Reeve", ( 20,160,600, 32 )
textlabel _skill , @"Skill level:", ( 20, 12, 75, 32 )
textfield _sum ,, @"0",( 530,85,90,60 )
button _btn1 ,, , @"1",( 245,20,50,50 ),,NSBezelStyleRegularSquare
button _btn2 ,, , @"2",( 295,20,50,50 ),,NSBezelStyleRegularSquare
button _btn3 ,, , @"3",( 345,20,50,50 ),,NSBezelStyleRegularSquare
ControlSetAlignment( _msg, NSTextAlignmentCenter )
ControlSetAlignment( _sum, NSTextAlignmentCenter )
TextFieldSetEditable( _sum, no )
ControlSetFontWithName( _msg, @"Menlo", 15.0 )
ControlSetFontWithName( _btn1, @"Menlo", 20.0 )
ControlSetFontWithName( _btn2, @"Menlo", 20.0 )
ControlSetFontWithName( _btn3, @"Menlo", 20.0 )
ControlSetFontWithName( _sum, @"Menlo", 32.0 )
text @"menlo", 15.0
end fn
local fn show( add as byte )
CFStringRef msg
if (sum + add) > 21 then beep : exit fn
button 1, who : button 2, who : button 3, who
sum += add : cls
ControlSetIntegerValue( _sum, sum )
string( who ) += "+" + chr$( add or 48 ) + " "
print cr;cr;cr;string( _human );cr;cr;string( _robot )
if sum < 21
if who == _robot then msg = @"Your turn..." else msg = @"My turn..."
else
if who == _robot
msg = @"Too bad. I win. Press any key to play again."
else
msg = @"Congratulations! YOU WIN! Press any key to play again."
end if
end if
if peek( @string( who ) ) > 20 then textlabel _msg, msg
who = who xor _robot
end fn
local fn play( add as byte )
if sum + add > 21 then beep : exit fn
fn show( add ) //Show human's play
if sum < 21
if (skill + maybe) > 0 then num = best(sum mod 4) else num = rnd(3)
if sum + num > 21 then num = 21 - sum
timerbegin 1.0, NO //wait a sec before playing
fn show( num ) //Show computer's play
timerend
end if
end fn
local fn start
sum = 0 : cls
string( _human ) = " You: " : string( _robot ) = " Computer: "
string( 1-who ) += " "
if who == _robot
if skill == 2 then num = 1 else num = rnd( 3 )
textlabel _msg, fn StringWithFormat( @"I'll start with %i.", num )
fn show( num )
else
ControlSetIntegerValue( _sum, sum )
textlabel _msg, @"You start. Type or click 1, 2, or 3."
end if
end fn
local fn DoDialog( evt as long, tag as long)
byte key
select ( evt )
case _windowKeyUp
if sum == 21 then fn start : exit fn
if who == _robot then exit fn
key = intval( fn EventCharacters )
if key > 0 && key < 4 then fn play( key )
case _btnClick
if tag < _popup then beep : fn play( tag ) : exit fn
skill = popupbutton( _popup )
case _windowWillClose : end
end select
end fn
fn buildWindow
fn start
on dialog fn doDialog
handleevents

58
Task/21-game/Koka/21-game.koka Normal file
View file

@ -0,0 +1,58 @@
import std/num/random
import std/os/readline
effect exit
final ctl exit(): ()
type player
Player
Computer
fun other(p: player): player
match p
Player -> Computer
Computer -> Player
fun show(p: player): string
match p
Player -> "Player"
Computer -> "Computer"
fun get-selection(max-int: int)
val i = readline().trim().parse-int()
match i
Just(x) | x >= 1 && x <= max-int -> x
_ ->
println("Please enter a number between 1 and " ++ max-int.show ++ " or press q to quit")
get-selection(max-int)
fun play(p: player, total: int)
println("Total: " ++ total.show)
match total
21 ->
// The player who reaches 21 wins the game, which is the player in the last loop
println(p.other.show ++ " wins!")
return ()
_ -> ()
val max = if total + 3 > 21 then 21 - total else 3
match p
Player ->
println("Player's turn")
val selection = get-selection(max)
play(p.other, total + selection)
Computer ->
println("Computer's turn")
val selection = (random-int() % max) + 1
println("Computer chooses " ++ selection.show)
play(p.other, total + selection)
fun main()
with final ctl exit() ()
"21 is a two player game. The game is played by choosing a number (1, 2, 3) to".println
"be added to the running total. The game is won by the player whose chosen number".println
"causes the running total to reach exactly 21. The running total starts at zero.".println
"".println
"You can quit the game at any time by typing 'q'.".println
val playerGoesFirst = random-bool()
val p1 = if playerGoesFirst then Player else Computer
play(p1, 0)

97
Task/24-game/Koka/24-game.koka Normal file
View file

@ -0,0 +1,97 @@
import std/num/random
import std/os/readline
type expr
Num(i: int)
Add(e1: expr, e2: expr)
Sub(e1: expr, e2: expr)
Mul(e1: expr, e2: expr)
Div(e1: expr, e2: expr)
fun genNum()
random-int() % 9 + 1
fun parseFact(s: string): <div,exn> (expr, string)
match s.head
"(" ->
val (e, rest) = s.tail.parseExpr()
match rest.head
")" -> (e, rest.tail)
_ -> throw("expected ')'")
x | x.head-char.default('_').is-digit -> (Num(x.parse-int.unjust), s.tail)
_ -> throw("No factor")
fun parseTerm(s): <div,exn> (expr, string)
val (e', n) = s.parseFact()
match n.head
"*" ->
val (e'', n') = n.tail.parseTerm()
(Mul(e', e''), n')
"/" ->
val (e'', n') = n.tail.parseTerm()
(Div(e', e''), n')
_ -> (e', n)
fun parseExpr(s): <div,exn> (expr, string)
val (e', n) = s.parseTerm()
match n.head
"+" ->
val (e'', n') = n.tail.parseExpr()
(Add(e', e''), n')
"-" ->
val (e'', n') = n.tail.parseExpr()
(Sub(e', e''), n')
_ -> (e', n)
fun numbers(e: expr): div list<int>
match e
Num(i) -> [i]
Add(e1, e2) -> numbers(e1) ++ numbers(e2)
Sub(e1, e2) -> numbers(e1) ++ numbers(e2)
Mul(e1, e2) -> numbers(e1) ++ numbers(e2)
Div(e1, e2) -> numbers(e1) ++ numbers(e2)
fun check(e: expr, l: list<int>): <div,exn> ()
val ns = numbers(e)
if (ns.length == 4) then
if l.all(fn(n) ns.any(fn(x) x == n)) then
()
else
throw("wrong numbers")
else
throw("wrong number of numbers")
fun evaluate(e: expr): float64
match e
Num(i) -> i.float64
Add(e1, e2) -> evaluate(e1) + evaluate(e2)
Sub(e1, e2) -> evaluate(e1) - evaluate(e2)
Mul(e1, e2) -> evaluate(e1) * evaluate(e2)
Div(e1, e2) -> evaluate(e1) / evaluate(e2)
fun main()
println("\nGoal: ")
println("- Create an expression that evaluates to 24")
println("- Using the four given numbers each number once")
println("- Using the operators (+-/*) with no spaces")
println("Example 2 3 4 1: (2+3)*4*1\n")
println("Here are your numbers!")
var l: list<int> := Nil
repeat(4) fn()
val n = genNum()
l := Cons(n, l)
(n.show ++ " ").print
println("")
var found := False
while { !found } fn()
val (expr, r) = readline().parseExpr()
if r.count > 0 then
println("Expected EOF but got: " ++ r ++ " please try again")
return ()
expr.check(l)
val result = expr.evaluate()
if result == 24.0 then
println("You got it!")
found := True
else
println("Try again, your expression evaluated to: " ++ result.show)

39
Task/4-rings-or-4-squares-puzzle/Koka/4-rings-or-4-squares-puzzle.koka Normal file
View file

@ -0,0 +1,39 @@
fun is_unique(a: int, b: int, c: int, d: int, e: int, f: int, g: int)
a != b && a != c && a != d && a != e && a != f && a != g &&
b != c && b != d && b != e && b != f && b != g &&
c != d && c != e && c != f && c != g &&
d != e && d != f && d != g &&
e != f && e != g &&
f != g
fun is_solution(a: int, b: int, c: int, d: int, e: int, f: int, g: int)
val bcd = b + c + d
val ab = a + b
if ab != bcd then return False
val def = d + e + f
if bcd != def then return False
val fg = f + g
return def == fg
fun four_squares(low: int, high: int, unique:bool=True)
var count := 0
for(low, high) fn(a)
for(low, high) fn(b)
for(low, high) fn(c)
for(low, high) fn(d)
for(low, high) fn(e)
for(low, high) fn(f)
for(low, high) fn(g)
if (!unique || is_unique(a, b, c, d, e, f, g)) && is_solution(a, b, c, d, e, f, g) then
count := count + 1
if unique then
println([a, b, c, d, e, f, g].show)
else
()
val uniquestr = if unique then "unique" else "non-unique"
println(count.show ++ " " ++ uniquestr ++ " solutions in " ++ low.show ++ " to " ++ high.show ++ " range\n")
fun main()
four_squares(1, 7)
four_squares(3, 9)
four_squares(0, 9, False)

0
Task/99-bottles-of-beer/Smalltalk/99-bottles-of-beer.st → Task/99-bottles-of-beer/Smalltalk/99-bottles-of-beer-1.st
View file

11
Task/99-bottles-of-beer/Smalltalk/99-bottles-of-beer-2.st Normal file
View file

@ -0,0 +1,11 @@
|bottles plurals |
Transcript clear.
bottles:='{1} bottle{2} of beer on the wall
{1} bottle{2} of beer
Take one down, pass it around
{3} bottle{4} of beer on the wall'.
plurals := #('' 's').
99 to: 1 by: -1 do:[:v |
Transcript show: (bottles format: {(v asString) . (plurals atPin:v) . ((v -1) asString). (plurals atPin:v) }); cr; cr].
Transcript show: 'hic!'; cr.

13
Task/99-bottles-of-beer/Smalltalk/99-bottles-of-beer-3.st Normal file
View file

@ -0,0 +1,13 @@
| bottles |
Transcript clear.
bottles := '{1} {2} of beer on the wall
{1} {2} of beer
Take one down, pass it around
{3} {4} of beer on the wall'.
99 to: 1 by: -1 do: [:i |
Transcript
show: (bottles format: {
i. 'bottle' asPluralBasedOn: i.
i - 1. 'bottle' asPluralBasedOn: i - 1});
cr; cr].
Transcript show: 'hic!'; cr.

59
Task/ABC-problem/Elm/abc-problem.elm Normal file
View file

@ -0,0 +1,59 @@
import Html exposing (div, p, text)
type alias Block = (Char, Char)
writtenWithBlock : Char -> Block -> Bool
writtenWithBlock letter (firstLetter, secondLetter) =
letter == firstLetter || letter == secondLetter
canMakeWord : List Block -> String -> Bool
canMakeWord blocks word =
let
checkWord w examinedBlocks blocksToExamine =
case (String.uncons w, blocksToExamine) of
(Nothing, _) -> True
(Just _, []) -> False
(Just (firstLetter, restOfWord), firstBlock::restOfBlocks) ->
if writtenWithBlock firstLetter firstBlock
then checkWord restOfWord [] (examinedBlocks ++ restOfBlocks)
else checkWord w (firstBlock::examinedBlocks) restOfBlocks
in
checkWord (String.toUpper word) [] blocks
exampleBlocks =
[ ('B', 'O')
, ('X', 'K')
, ('D', 'Q')
, ('C', 'P')
, ('N', 'A')
, ('G', 'T')
, ('R', 'E')
, ('T', 'G')
, ('Q', 'D')
, ('F', 'S')
, ('J', 'W')
, ('H', 'U')
, ('V', 'I')
, ('A', 'N')
, ('O', 'B')
, ('E', 'R')
, ('F', 'S')
, ('L', 'Y')
, ('P', 'C')
, ('Z', 'M')
]
exampleWords =
["", "A", "bark", "BoOK", "TrEAT", "COmMoN", "Squad", "conFUsE"]
main =
let resultStr (word, canBeWritten) = "\"" ++ word ++ "\"" ++ ": " ++ if canBeWritten then "True" else "False" in
List.map (\ word -> (word, canMakeWord exampleBlocks word) |> resultStr) exampleWords
|> List.map (\result -> p [] [ text result ])
|> div []

30
Task/ABC-problem/FutureBasic/abc-problem-1.basic Normal file
View file

@ -0,0 +1,30 @@
include "NSLog.incl"
local fn CanBlocksSpell( w as CFStringRef ) as CFStringRef
NSUInteger i, j
CFStringRef s = @"", t1, t2 : if fn StringIsEqual( w, @"" ) then exit fn = @"YES" else w = ucase(w)
mda(0) = {@"BO",@"XK",@"DQ",@"CP",@"NA",@"GT",@"RE",@"TG",@"QD",¬
@"FS",@"JW",@"HU",@"VI",@"AN",@"OB",@"ER",@"FS",@"LY",@"PC",@"ZM"}
for i = 0 to len(w) - 1
for j = 0 to mda_count - 1
t1 = mid( mda(j), 0, 1 ) : t2 = mid( mda(j), 1, 1 )
if ( fn StringIsEqual( mid( w, i, 1 ), t1 ) ) then s = fn StringByAppendingString( s, t1 ) : mda(j) = @" " : break
if ( fn StringIsEqual( mid( w, i, 1 ), t2 ) ) then s = fn StringByAppendingString( s, t2 ) : mda(j) = @" " : break
next
next
if fn StringIsEqual( s, w ) then exit fn = @"YES"
end fn = @"NO"
NSUInteger i
CFArrayRef words
CFStringRef w
words = @[@"", @"a",@"Bark",@"BOOK",@"TrEaT",@"COMMON",@"Squad",@"conFUse",@"ABBA",@"aUtO"]
for w in words
printf @"Can blocks spell %7s : %@", fn StringUTF8String( w ), fn CanBlocksSpell( w )
next
NSLog( @"%@", fn WindowPrintViewString( 1 ) )
HandleEvents

18
Task/ABC-problem/FutureBasic/abc-problem-2.basic Normal file
View file

@ -0,0 +1,18 @@
local fn blocks( wordList as str255 )
sint16 found, r, x = 3, y = -9 : str63 ch, blocks : ch = " " : blocks = " "
for r = 1 to len$( wordList ) +1
found = instr$( 1, blocks, ch )
select found
case > 3: mid$( blocks, found and -2, 2 ) = "__" : text , , fn ColorYellow
rect fill ( x, y + 5.5, 15, 15 ), fn ColorBrown
case 0: text , , fn ColorLightGray
case < 4: blocks=" ,;BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM": x=3: y+=26: ch=""
end select
text @"Courier New Bold", 16 : print %( x + 2.5, y ) ch : x += 17
ch = ucase$( mid$( wordList, r, 1 ) )
next
end fn
window 1, @"ABC problem in FutureBasic", ( 0, 0, 300, 300 )
fn blocks( "a baRk booK;treat,COMMON squad Confused comparable incomparable nondeductibles" )
handleevents

41
Task/ABC-problem/FutureBasic/abc-problem.basic
View file

@ -1,41 +0,0 @@
include "NSLog.incl"
local fn CanBlocksSpell( w as CFStringRef ) as CFStringRef
NSUInteger i, j
CFStringRef cFinal = @"", result = @"NO"
CFMutableArrayRef blocks
blocks = fn MutableArrayWithArray( @[@"BO", @"XK", @"DQ", @"CP",¬
@"NA", @"GT", @"RE", @"TG", @"QD", @"FS", @"JW", @"HU", @"VI",¬
@"AN", @"OB", @"ER", @"FS", @"LY", @"PC", @"ZM"] )
CFStringRef cfStr = fn StringUppercaseString( w )
NSUInteger length = fn StringLength( cfStr )
NSUInteger count = fn ArrayCount( blocks )
for i = 0 to length - 1
for j = 0 to count - 1
CFStringRef charStr = mid( cfStr, i, 1 )
CFStringRef compareStr = fn ArrayObjectAtIndex( blocks, j )
CFStringRef testStr1 = mid( compareStr, 0, 1 )
CFStringRef testStr2 = mid( compareStr, 1, 1 )
if ( fn StringIsEqual( charStr, testStr1 ) == YES )
cFinal = fn StringByAppendingString( cFinal, testStr1 ) : MutableArrayReplaceObjectAtIndex( blocks, @" ", j ) : exit for
end if
if ( fn StringIsEqual( charStr, testStr2 ) == YES )
cFinal = fn StringByAppendingString( cFinal, testStr2 ) : MutableArrayReplaceObjectAtIndex( blocks, @" ", j ) : exit for
end if
next
next
if fn StringIsEqual( cFinal, cfStr ) == YES then result = @"YES"
end fn = result
NSLog( @"a: Can blocks spell? %@", fn CanBlocksSpell( @"a" ) )
NSLog( @"Bark: Can blocks spell? %@", fn CanBlocksSpell( @"Bark" ) )
NSLog( @"BOOK: Can blocks spell? %@", fn CanBlocksSpell( @"BOOK" ) )
NSLog( @"TrEaT: Can blocks spell? %@", fn CanBlocksSpell( @"TrEaT" ) )
NSLog( @"COMMON: Can blocks spell? %@", fn CanBlocksSpell( @"COMMON" ) )
NSLog( @"Squad: Can blocks spell? %@", fn CanBlocksSpell( @"Squad" ) )
NSLog( @"conFUse: Can blocks spell? %@", fn CanBlocksSpell( @"conFUse" ) )
HandleEvents

42
Task/ABC-problem/Koka/abc-problem.koka Normal file
View file

@ -0,0 +1,42 @@
val blocks = [("B", "O"),
("X", "K"),
("D", "Q"),
("C", "P"),
("N", "A"),
("G", "T"),
("R", "E"),
("T", "G"),
("Q", "D"),
("F", "S"),
("J", "W"),
("H", "U"),
("V", "I"),
("A", "N"),
("O", "B"),
("E", "R"),
("F", "S"),
("L", "Y"),
("P", "C"),
("Z", "M")]
pub fun get-remove( xs : list<a>, pred : a -> bool, acc: ctx<list<a>>) : (maybe<a>, list<a>)
match xs
Cons(x,xx) -> if !pred(x) then xx.get-remove(pred, acc ++ ctx Cons(x, _)) else (Just(x), acc ++. xx)
Nil -> (Nothing, acc ++. Nil)
fun check-word(word: string, blocks: list<(string, string)>)
match word.head
"" -> True
x ->
val (a, l) = blocks.get-remove(fn(a) a.fst == x || a.snd == x, ctx _)
match a
Nothing -> False
Just(_) -> check-word(word.tail, l)
fun can-make-word(word, blocks: list<(string, string)>)
check-word(word.to-upper, blocks)
fun main()
val words = ["", "a", "baRk", "booK", "treat", "COMMON", "squad", "Confused"]
words.map(fn(a) (a, can-make-word(a, blocks))).foreach fn((w, b))
println(w.show ++ " " ++ (if b then "can" else "cannot") ++ " be made")

792
Task/ADFGVX-cipher/AArch64-Assembly/adfgvx-cipher.aarch64 Normal file
View file

@ -0,0 +1,792 @@
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program adfgvx64.s */
/* remark 1 : At each launch, the random values are identical.
To change them, modify the value of the seed (graine) */
/* remark 2 : this program not run in android with termux
because the call system stats is not find */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ SIZE, 6
.equ SIZEC, SIZE * SIZE
.equ KEYSIZE, 9
.equ FSTAT, 80
.equ O_RDWR, 0x0002 // open for reading and writing
/*******************************************/
/* Structures **/
/*******************************************/
/* structure de type stat 64 bits : infos fichier */
.struct 0
Stat_dev_t: // ID of device containing file
.struct Stat_dev_t + 8
Stat_ino_t: // inode
.struct Stat_ino_t + 4
Stat_mode_t: // File type and mode
.struct Stat_mode_t + 4
Stat_nlink_t: // Number of hard links
.struct Stat_nlink_t + 4
Stat_uid_t: // User ID of owner
.struct Stat_uid_t + 8
Stat_gid_t: // Group ID of owner
.struct Stat_gid_t + 8
Stat_rdev_t: // Device ID (if special file)
.struct Stat_rdev_t + 8
Stat_size_deb: // la taille est sur 8 octets si gros fichiers
.struct Stat_size_deb + 4
Stat_size_t: // Total size, in bytes
.struct Stat_size_t + 4
Stat_blksize_t: // Block size for filesystem I/O
.struct Stat_blksize_t + 4
Stat_blkcnt_t: // Number of 512B blocks allocated
.struct Stat_blkcnt_t + 4
Stat_atime: // date et heure fichier
.struct Stat_atime + 8
Stat_mtime: // date et heure modif fichier
.struct Stat_atime + 8
Stat_ctime: // date et heure creation fichier
.struct Stat_atime + 8
Stat_Fin:
/*********************************/
/* Initialized data */
/*********************************/
.data
szText: .asciz "ATTACKAT1200AM"
//szText: .asciz "ABCDEFGHIJ"
szMessOpen: .asciz "File open error.\n"
szMessStat: .asciz "File information error.\n"
szMessRead: .asciz "File read error.\n"
szMessClose: .asciz "File close error.\n"
szMessDecryptText: .asciz "Decrypted text :\n"
szMessCryptText: .asciz "Encrypted text :\n"
szMessErrorChar: .asciz "Character text not Ok!\n"
szFileName: .asciz "unixdict.txt"
szMessPolybius: .asciz "6 x 6 Polybius square:\n"
szTitle: .asciz " | A D F G V X\n---------------\n"
szLine1: .asciz "A | \n"
szLine2: .asciz "D | \n"
szLine3: .asciz "F | \n"
szLine4: .asciz "G | \n"
szLine5: .asciz "V | \n"
szLine6: .asciz "X | \n"
szListCharCode: .asciz "ADFGVX"
szListChar: .asciz "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
.equ LGLISTCHAR, . - szListChar - 1
szMessStart: .asciz "Program 64 bits start.\n"
szCarriageReturn: .asciz "\n"
.align 4
qGraine: .quad 1234567 // random init
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sKeyWord: .skip 16
sKeyWordSorted: .skip 16
tabPolybius: .skip SIZE * SIZE + 4
sBuffer: .skip 1000
sBuffex1: .skip 1000
sBuffex2: .skip 1000
tabPosit: .skip 16
tabPositInv: .skip 16
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessStart
bl affichageMess
bl createPolybius // create 6*6 polybius
ldr x0,qAdrsKeyWord
bl generateKey // generate key
cmp x0,#-1 // file error ?
beq 100f
bl affichageMess // display key
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszMessCryptText
bl affichageMess
ldr x0,qAdrszText // text encrypt
ldr x1,qAdrtabPolybius
ldr x2,qAdrsKeyWord
ldr x3,qAdrsBuffer // result buffer
bl encryption
cmp x0,#-1 // error if unknow character in text
beq 100f
bl affichageMess // display text encrypted
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszMessDecryptText
bl affichageMess
ldr x0,qAdrsBuffer // text decrypt
ldr x1,qAdrtabPolybius
ldr x2,qAdrsKeyWord
ldr x3,qAdrsBuffex1 // result buffer
bl decryption
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszMessDecryptText: .quad szMessDecryptText
qAdrszMessCryptText: .quad szMessCryptText
qAdrszMessStart: .quad szMessStart
qAdrsKeyWord: .quad sKeyWord
qAdrszText: .quad szText
/***************************************************/
/* create 6 * 6 polybius */
/***************************************************/
createPolybius:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
ldr x0,qAdrszListChar // character list address
mov x1,#LGLISTCHAR // character list size
ldr x2,qAdrtabPolybius
bl shufflestrings // shuffle list
ldr x0,qAdrszMessPolybius
bl affichageMess
ldr x0,qAdrszTitle // display polybius lines
bl affichageMess
ldr x0,qAdrszLine1
mov x3,#0
mov x4,#4
1:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE
blt 1b
bl affichageMess
ldr x0,qAdrszLine2
mov x3,#SIZE
mov x4,#4
2:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE * 2
blt 2b
bl affichageMess
ldr x0,qAdrszLine3
mov x3,#SIZE * 2
mov x4,#4
3:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE * 3
blt 3b
bl affichageMess
ldr x0,qAdrszLine4
mov x3,#SIZE * 3
mov x4,#4
4:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE * 4
blt 4b
bl affichageMess
ldr x0,qAdrszLine5
mov x3,#SIZE * 4
mov x4,#4
5:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE * 5
blt 5b
bl affichageMess
ldr x0,qAdrszLine6
mov x3,#SIZE * 5
mov x4,#4
6:
ldrb w1,[x2,x3]
strb w1,[x0,x4]
add x4,x4,#2
add x3,x3,#1
cmp x3,#SIZE * 6
blt 6b
bl affichageMess
100:
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
qAdrszListChar: .quad szListChar
qAdrtabPolybius: .quad tabPolybius
qAdrszMessPolybius: .quad szMessPolybius
qAdrszTitle: .quad szTitle
qAdrszLine1: .quad szLine1
qAdrszLine2: .quad szLine2
qAdrszLine3: .quad szLine3
qAdrszLine4: .quad szLine4
qAdrszLine5: .quad szLine5
qAdrszLine6: .quad szLine6
/***************************************************/
/* generate key word */
/***************************************************/
/* x0 key word address */
generateKey:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
stp x8,x9,[sp,-16]!
stp x10,x11,[sp,-16]!
stp x12,x13,[sp,-16]!
mov x9,x0
mov x0,AT_FDCWD
ldr x1,qAdrszFileName // file name
mov x2,#O_RDWR // flags
mov x3,#0 // mode
mov x8,#OPEN // file open
svc 0
cmp x0,#0 // error ?
ble 99f
mov x11,x0 // FD save
ldr x1,qAdrsBuffer // buffer address
mov x8, #FSTAT // call systeme NEWFSTAT
svc 0
cmp x0,#0
blt 98f
// load file size
ldr x1,qAdrsBuffer // buffer address
ldr w6,[x1,#Stat_size_t] // file size
//ldr w6,[x1,mbox_data_size]
lsr x12,x6,#5 // align size to multiple 16 for stack alignement
lsl x12,x12,#5
add x12,x12,#32 // add for great buffer
sub sp,sp,x12 // reserve buffer on stack
mov fp,sp // address save
mov x0,x11
mov x1,fp
mov x2,x12
mov x8,#READ // call system read file
svc 0
cmp x0,#0 // error read ?
blt 97f
mov x0,x11
mov x8,#CLOSE // call system close file
svc 0
cmp x0,#0 // error close ?
blt 96f
sub sp,sp,#0x1000 // create array word address on stack
mov x10,sp // save address array
mov x1,#0
mov x2,fp
mov x5,#0 // index word ok
mov x3,#0 // word length
1:
ldrb w4,[fp,x1] // load character
cmp w4,#0x0D // end word ?
beq 2f // yes
add x1,x1,#1
add x3,x3,#1
b 1b
2:
cmp x3,#KEYSIZE // word length = key length ?
bne 3f // no ?
mov x0,x2
bl wordControl // contril if all letters are différent ?
cmp x0,#1
bne 3f
str x2,[x10,x5,lsl #3] // if ok store word address in array on stack
add x5,x5,#1 // increment word counter
3:
add x1,x1,#2
cmp x1,x6 // end ?
beq 4f
add x2,fp,x1 // new word begin
mov x3,#0 // init word length
b 1b // and loop
4:
mov x0,x5 // number random to total words
bl genereraleas
ldr x2,[x10,x0,lsl #3] // load address word
mov x1,#0
5: // copy random word in word result
ldrb w3,[x2,x1]
strb w3,[x9,x1]
add x1,x1,#1
cmp x1,#KEYSIZE
blt 5b
strb wzr,[x9,x1] // zero final
mov x0,x9
b 100f
// display errors
96:
ldr x0,qAdrszMessClose
bl affichageMess
mov x0,#-1 // error
b 100f
97:
ldr x0,qAdrszMessRead
bl affichageMess
mov x0,#-1 // error
b 100f
98:
ldr x0,qAdrszMessStat
bl affichageMess
mov x0,#-1 // error
b 101f
99:
ldr x0,qAdrszMessOpen
bl affichageMess
mov x0,#-1 // error
b 101f
100:
add sp,sp,x12
add sp,sp,#0x1000
101:
ldp x12,x13,[sp],16
ldp x10,x11,[sp],16
ldp x8,x9,[sp],16
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
qAdrszFileName: .quad szFileName
qAdrszMessOpen: .quad szMessOpen
qAdrszMessRead: .quad szMessRead
qAdrszMessStat: .quad szMessStat
qAdrszMessClose: .quad szMessClose
qAdrsBuffer: .quad sBuffer
/******************************************************************/
/* control if letters are diferents */
/******************************************************************/
/* x0 contains the address of the string */
/* x0 return 1 if Ok else return 0 */
wordControl:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
mov x1,#0 // init index 1
1:
ldrb w3,[x0,x1] // load one character
cmp x3,#0x0D // end word ?
mov x5,#1
csel x0,x5,x0,eq // yes is ok
//moveq x0,#1 // yes is ok
beq 100f // -> end
add x2,x1,#1 // init index two
2:
ldrb w4,[x0,x2] // load one character
cmp w4,#0x0D // end word ?
add x5,x1,1
csel x1,x5,x1,eq // yes increment index 1
beq 1b // and loop1
cmp x3,x4 // caracters equals ?
csel x0,xzr,x0,eq // yes is not good
beq 100f // and end
add x2,x2,#1 // else increment index 2
b 2b // and loop 2
100:
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
/******************************************************************/
/* key sort by insertion sort */
/******************************************************************/
/* x0 contains the address of String */
/* x1 contains the first element */
/* x2 contains the number of element */
/* x3 contains result address */
keySort:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
stp x8,x9,[sp,-16]!
stp x10,x11,[sp,-16]!
ldr x7,qAdrtabPosit
mov x10,x3
mov x3,#0
0: // init position array and copy key
strb w3,[x7,x3] // in result array
ldrb w4,[x0,x3]
strb w4,[x10,x3]
add x3,x3,#1
cmp x3,#KEYSIZE
blt 0b
add x3,x1,#1 // start index i
1: // start loop
ldrb w4,[x10,x3] // load value A[i]
ldrb w8,[x7,x3] // load position
sub x5,x3,#1 // index j
2:
ldrb w6,[x10,x5] // load value A[j]
ldrb w9,[x7,x5] // load position
cmp x6,x4 // compare value
ble 3f
add x5,x5,#1 // increment index j
strb w6,[x10,x5] // store value A[j+1]
strb w9,[x7,x5] // store position
subs x5,x5,#2 // j = j - 1
bge 2b // loop if j >= 0
3:
add x5,x5,#1 // increment index j
strb w4,[x10,x5] // store value A[i] in A[j+1]
strb w8,[x7,x5]
add x3,x3,#1 // increment index i
cmp x3,x2 // end ?
blt 1b // no -> loop
ldr x1,qAdrtabPositInv // inverse position
mov x2,#0 // index
4:
ldrb w3,[x7,x2] // load position index
strb w2,[x1,x3] // store index in position
add x2,x2,#1 // increment index
cmp x2,#KEYSIZE // end ?
blt 4b
mov x0,x10
100:
ldp x10,x11,[sp],16
ldp x8,x9,[sp],16
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16 // TODO: retaur à completer
ret
qAdrtabPosit: .quad tabPosit
qAdrtabPositInv: .quad tabPositInv
/******************************************************************/
/* text encryption */
/******************************************************************/
/* x0 contains the address of text */
/* x1 contains polybius address
/* x2 contains the key address */
/* x3 contains result buffer address */
encryption:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
stp x8,x9,[sp,-16]!
stp x10,x11,[sp,-16]!
mov x9,x0 // save text address
mov x8,x3
mov x10,x1 // save address polybius
mov x0,x2 // key address
mov x1,#0 // first character
mov x2,#KEYSIZE // key length
ldr x3,qAdrsKeyWordSorted // result address
bl keySort // sort leters of key
// bl affichageMess // if you want display sorted key
// ldr x0,qAdrszCarriageReturn
// bl affichageMess
ldr x3,qAdrsBuffex1
mov x5,#0 // init text index
mov x4,#0 // init result index
1:
ldrb w0,[x9,x5] // load a byte to text
cmp x0,#0 // end ?
beq 4f
mov x6,#0 // init index polybius
2:
ldrb w7,[x10,x6] // load character polybius
cmp x7,x0 // equal ?
beq 3f
add x6,x6,#1 // increment index
cmp x6,#SIZEC // not find -> error
bge 99f
b 2b // and loop
3:
mov x0,x6
bl convPosCode // convert position in code character
strb w0,[x3,x4] // line code character
add x4,x4,#1
strb w1,[x3,x4] // column code character
add x4,x4,#1
add x5,x5,#1 // increment text index
b 1b
4:
mov x0,#0 // zero final -> text result
strb w0,[x3,x4]
mov x5,x3
mov x1,#0 // index position column
mov x7,#0 // index text
ldr x2,qAdrtabPositInv
5:
ldrb w0,[x2,x1] // load position text
7: // loop to characters transposition
ldrb w6,[x5,x0] // load character
strb w6,[x8,x7] // store position final
add x7,x7,#1 // increment final index
add x0,x0,#KEYSIZE // add size key
cmp x0,x4 // end ?
blt 7b
add x1,x1,#1 // add index column
cmp x1,#KEYSIZE // < key size
blt 5b // yes -> loop
mov x6,#0 // zero final
strb w6,[x8,x7]
mov x0,x8 // return address encrypted text
b 100f
99: // display error
ldr x0,qAdrszMessErrorChar
bl affichageMess
mov x0,#-1
100:
ldp x10,x11,[sp],16
ldp x8,x9,[sp],16
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
qAdrsBuffex1: .quad sBuffex1
qAdrsKeyWordSorted: .quad sKeyWordSorted
qAdrszMessErrorChar: .quad szMessErrorChar
/******************************************************************/
/* text decryption */
/******************************************************************/
/* x0 contains the address of text */
/* x1 contains polybius address
/* x2 contains the key */
/* x3 contains result buffer */
/* x0 return decoded text */
decryption:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
stp x8,x9,[sp,-16]!
stp x10,x11,[sp,-16]!
stp x12,x13,[sp,-16]!
mov x4,#0
1: // compute text length
ldrb w5,[x0,x4]
cmp x5,#0
add x11,x4,1
csel x4,x11,x4,ne
bne 1b
mov x12,x0
mov x11,x1
mov x10,x2
mov x13,x3
// compute line number and remainder
mov x1,#KEYSIZE // compute line number and remainder
udiv x8,x4,x1 // line number
msub x7,x8,x1,x4 // remainder characters last line
mov x0,x10 // key address
mov x1,#0 // first character
mov x2,#KEYSIZE // size
ldr x3,qAdrsKeyWordSorted // result address
bl keySort // sort key
ldr x10,qAdrtabPositInv // inverse position
mov x2,#0 // index colonne tabposit
mov x5,#0 // text index
mov x0,#0 // index line store text
mov x1,#0 // counter line
ldr x9,qAdrsBuffex2
1:
ldrb w3,[x10,x2] // load position
ldrb w6,[x12,x5] // load text character
add x3,x3,x0 // compute position with index line
strb w6,[x9,x3] // store character in good position
add x5,x5,#1 // increment index text
cmp x5,x4 // end ?
bge 4f
add x1,x1,#1 // increment line
cmp x1,x8 // line < line size
blt 2f
bgt 11f // line = line size
sub x3,x3,x0 // restaure position column
cmp x3,x7 // position < remainder so add character other line
blt 2f
11:
mov x1,#0 // init ligne
mov x0,#0 // init line shift
add x2,x2,#1 // increment index array position inverse
cmp x2,#KEYSIZE // end ?
csel x2,xzr,x2,ge // init index
b 3f
2:
add x0,x0,#KEYSIZE
3:
b 1b
4: // convertir characters with polybius
mov x3,#0
mov x5,#0
5:
mov x0,x11
ldrb w1,[x9,x3] // load a first character
add x3,x3,#1
ldrb w2,[x9,x3] // load a 2ieme character
bl decodPosCode // decode
strb w0,[x13,x5] // store result in final result
add x5,x5,#1 // increment final result index
add x3,x3,#1 // increment index text
cmp x3,x4 // end ?
blt 5b
mov x0,#0 // final zero
strb w0,[x13,x5]
mov x0,x13 // return final result address
100:
ldp x12,x13,[sp],16
ldp x10,x11,[sp],16
ldp x8,x9,[sp],16
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16 // TODO: retaur à completer
ret
qAdrsBuffex2: .quad sBuffex2
/******************************************************************/
/* convertir position en code */
/******************************************************************/
/* x0 contains the position in polybius */
/* x0 return code1 */
/* x1 return code2 */
convPosCode:
stp x2,lr,[sp,-16]!
stp x3,x4,[sp,-16]!
ldr x4,qAdrszListCharCode
mov x1,#SIZE
udiv x2,x0,x1
msub x3,x2,x1,x0
//bl division
ldrb w0,[x4,x2]
ldrb w1,[x4,x3]
100:
ldp x3,x4,[sp],16
ldp x2,lr,[sp],16
ret
qAdrszListCharCode: .quad szListCharCode
/******************************************************************/
/* convertir code en character */
/******************************************************************/
/* x0 polybius address */
/* x1 code 1 */
/* x2 code 2 */
/* x0 return character */
decodPosCode:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
ldr x4,qAdrszListCharCode
mov x3,#0
1:
ldrb w5,[x4,x3]
cmp x5,#0
beq 2f
cmp x5,x1
csel x1,x3,x1,eq
cmp x5,x2
csel x2,x3,x2,eq
add x3,x3,#1
b 1b
2:
mov x5,#SIZE
mul x1,x5,x1
add x1,x1,x2
ldrb w0,[x0,x1]
100:
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
/******************************************************************/
/* shuffle strings algorithme Fisher-Yates */
/******************************************************************/
/* x0 contains the address of the string */
/* x1 contains string length */
/* x2 contains address result string */
shufflestrings:
stp x1,lr,[sp,-16]! // TODO: save à completer
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
mov x3,#0
1: // loop copy string in result
ldrb w4,[x0,x3]
strb w4,[x2,x3]
add x3,x3,#1
cmp x3,x1
ble 1b
sub x1,x1,#1 // last element
2:
mov x0,x1
bl genereraleas // call random
ldrb w4,[x2,x1] // load byte string index loop
ldrb w3,[x2,x0] // load byte string random index
strb w3,[x2,x1] // and exchange
strb w4,[x2,x0]
subs x1,x1,#1
cmp x1,#1
bge 2b
100:
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
/***************************************************/
/* Generation random number */
/***************************************************/
/* x0 contains limit */
genereraleas:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
ldr x1,qAdrqGraine
ldr x2,[x1]
ldr x3,qNbDep1
mul x2,x3,x2
ldr x3,qNbDep2
add x2,x2,x3
str x2,[x1] // maj de la graine pour l appel suivant
cmp x0,#0
beq 100f
udiv x3,x2,x0
msub x0,x3,x0,x2 // résult = remainder
100: // end function
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrqGraine: .quad qGraine
qNbDep1: .quad 0x0019660d
qNbDep2: .quad 0x3c6ef35f
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../includeARM64.inc"

715
Task/ADFGVX-cipher/ARM-Assembly/adfgvx-cipher.arm Normal file
View file

@ -0,0 +1,715 @@
/* ARM assembly Raspberry PI */
/* program adfgvx.s */
/* remark 1 : At each launch, the random values are identical.
To change them, modify the value of the seed (graine) */
/* remark 2 : this program not run in android with termux
because the call system stats is not find */
/************************************/
/* Constantes */
/************************************/
/* for constantes see task include a file in arm assembly */
.include "../constantes.inc"
.equ SIZE, 6
.equ SIZEC, SIZE * SIZE
.equ KEYSIZE, 9
.equ READ, 3
.equ WRITE, 4
.equ OPEN, 5
.equ CLOSE, 6
.equ FSTAT, 0x6C
.equ O_RDWR, 0x0002 @ open for reading and writing
/**********************************************/
/* structure de type stat : infos fichier */
/**********************************************/
.struct 0
Stat_dev_t: @ ID of device containing file
.struct Stat_dev_t + 4
Stat_ino_t: @ inode
.struct Stat_ino_t + 2
Stat_mode_t: @ File type and mode
.struct Stat_mode_t + 2
Stat_nlink_t: @ Number of hard links
.struct Stat_nlink_t + 2
Stat_uid_t: @ User ID of owner
.struct Stat_uid_t + 2
Stat_gid_t: @ Group ID of owner
.struct Stat_gid_t + 2
Stat_rdev_t: @ Device ID (if special file)
.struct Stat_rdev_t + 2
Stat_size_deb: @ la taille est sur 8 octets si gros fichiers
.struct Stat_size_deb + 4
Stat_size_t: @ Total size, in bytes
.struct Stat_size_t + 4
Stat_blksize_t: @ Block size for filesystem I/O
.struct Stat_blksize_t + 4
Stat_blkcnt_t: @ Number of 512B blocks allocated
.struct Stat_blkcnt_t + 4
Stat_atime: @ date et heure fichier
.struct Stat_atime + 8
Stat_mtime: @ date et heure modif fichier
.struct Stat_atime + 8
Stat_ctime: @ date et heure creation fichier
.struct Stat_atime + 8
Stat_Fin:
/*********************************/
/* Initialized data */
/*********************************/
.data
szText: .asciz "ATTACKAT1200AM"
//szText: .asciz "ABCDEFGHIJ"
szMessOpen: .asciz "File open error.\n"
szMessStat: .asciz "File information error.\n"
szMessRead: .asciz "File read error.\n"
szMessClose: .asciz "File close error.\n"
szMessDecryptText: .asciz "Decrypted text :\n"
szMessCryptText: .asciz "Encrypted text :\n"
szMessErrorChar: .asciz "Character text not Ok!\n"
szFileName: .asciz "unixdict.txt"
szMessPolybius: .asciz "6 x 6 Polybius square:\n"
szTitle: .asciz " | A D F G V X\n---------------\n"
szLine1: .asciz "A | \n"
szLine2: .asciz "D | \n"
szLine3: .asciz "F | \n"
szLine4: .asciz "G | \n"
szLine5: .asciz "V | \n"
szLine6: .asciz "X | \n"
szListCharCode: .asciz "ADFGVX"
szListChar: .asciz "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
.equ LGLISTCHAR, . - szListChar - 1
szMessStart: .asciz "Program 32 bits start.\n"
szCarriageReturn: .asciz "\n"
.align 4
iGraine: .int 1234567 // random init
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sKeyWord: .skip 16
sKeyWordSorted: .skip 16
tabPolybius: .skip SIZE * SIZE + 4
sBuffer: .skip 1000
sBuffer1: .skip 1000
sBuffer2: .skip 1000
tabPosit: .skip 16
tabPositInv: .skip 16
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessStart
bl affichageMess
bl createPolybius @ create 6*6 polybius
ldr r0,iAdrsKeyWord
bl generateKey @ generate key
cmp r0,#-1 @ file error ?
beq 100f
bl affichageMess @ display key
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszMessCryptText
bl affichageMess
ldr r0,iAdrszText @ text encrypt
ldr r1,iAdrtabPolybius
ldr r2,iAdrsKeyWord
ldr r3,iAdrsBuffer @ result buffer
bl encryption
cmp r0,#-1 @ error if unknow character in text
beq 100f
bl affichageMess @ display text encrypted
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszMessDecryptText
bl affichageMess
ldr r0,iAdrsBuffer @ text decrypt
ldr r1,iAdrtabPolybius
ldr r2,iAdrsKeyWord
ldr r3,iAdrsBuffer1 @ result buffer
bl decryption
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszMessDecryptText: .int szMessDecryptText
iAdrszMessCryptText: .int szMessCryptText
iAdrszMessStart: .int szMessStart
iAdrsKeyWord: .int sKeyWord
iAdrszText: .int szText
/***************************************************/
/* create 6 * 6 polybius */
/***************************************************/
createPolybius:
push {r1-r4,lr} @ save des registres
ldr r0,iAdrszListChar @ character list address
mov r1,#LGLISTCHAR @ character list size
ldr r2,iAdrtabPolybius
bl shufflestrings @ shuffle list
ldr r0,iAdrszMessPolybius
bl affichageMess
ldr r0,iAdrszTitle @ display polybius lines
bl affichageMess
ldr r0,iAdrszLine1
mov r3,#0
mov r4,#4
1:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE
blt 1b
bl affichageMess
ldr r0,iAdrszLine2
mov r3,#SIZE
mov r4,#4
2:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE * 2
blt 2b
bl affichageMess
ldr r0,iAdrszLine3
mov r3,#SIZE * 2
mov r4,#4
3:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE * 3
blt 3b
bl affichageMess
ldr r0,iAdrszLine4
mov r3,#SIZE * 3
mov r4,#4
4:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE * 4
blt 4b
bl affichageMess
ldr r0,iAdrszLine5
mov r3,#SIZE * 4
mov r4,#4
5:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE * 5
blt 5b
bl affichageMess
ldr r0,iAdrszLine6
mov r3,#SIZE * 5
mov r4,#4
6:
ldrb r1,[r2,r3]
strb r1,[r0,r4]
add r4,r4,#2
add r3,r3,#1
cmp r3,#SIZE * 6
blt 6b
bl affichageMess
100:
pop {r1-r4,pc}
iAdrszListChar: .int szListChar
iAdrtabPolybius: .int tabPolybius
iAdrszMessPolybius: .int szMessPolybius
iAdrszTitle: .int szTitle
iAdrszLine1: .int szLine1
iAdrszLine2: .int szLine2
iAdrszLine3: .int szLine3
iAdrszLine4: .int szLine4
iAdrszLine5: .int szLine5
iAdrszLine6: .int szLine6
/***************************************************/
/* generate key word */
/***************************************************/
/* r0 key word address */
generateKey:
push {r1-r12,lr} @ save registers
mov r9,r0
ldr r0,iAdrszFileName @ file name
mov r1,#O_RDWR @ flags
mov r2,#0 @ mode
mov r7,#OPEN @ file open
svc 0
cmp r0,#0 @ error ?
ble 99f
mov r8,r0 @ FD save
ldr r1,iAdrsBuffer @ buffer address
mov r7, #FSTAT @ call systeme NEWFSTAT
svc 0
cmp r0,#0
blt 98f
@ load file size
ldr r1,iAdrsBuffer @ buffer address
ldr r6,[r1,#Stat_size_t] @ file size
lsr r12,r6,#3 @ align size to multiple 4
lsl r12,#3
add r12,#8 @ add for great buffer
sub sp,sp,r12 @ reserve buffer on stack
mov fp,sp @ address save
mov r0,r8
mov r1,fp
mov r2,r12
mov r7,#READ @ call system read file
svc 0
cmp r0,#0 @ error read ?
blt 97f
mov r0,r8
mov r7,#CLOSE @ call system close file
svc 0
cmp r0,#0 @ error close ?
blt 96f
sub sp,sp,#0x1000 @ create array word address on stack
mov r10,sp @ save address array
mov r1,#0
mov r2,fp
mov r5,#0 @ index word ok
mov r3,#0 @ word length
1:
ldrb r4,[fp,r1] @ load character
cmp r4,#0x0D @ end word ?
beq 2f @ yes
add r1,r1,#1
add r3,r3,#1
b 1b
2:
cmp r3,#KEYSIZE @ word length = key length ?
bne 3f @ no ?
mov r0,r2
bl wordControl @ contril if all letters are différent ?
cmp r0,#1
streq r2,[r10,r5,lsl #2] @ if ok store word address in array on stack
addeq r5,r5,#1 @ increment word counter
3:
add r1,r1,#2
cmp r1,r6 @ end ?
beq 4f
add r2,fp,r1 @ new word begin
mov r3,#0 @ init word length
b 1b @ and loop
4:
mov r0,r5 @ number random to total words
bl genereraleas
ldr r2,[r10,r0,lsl #2] @ load address word
mov r1,#0
5: @ copy random word in word result
ldrb r3,[r2,r1]
strb r3,[r9,r1]
add r1,r1,#1
cmp r1,#KEYSIZE
blt 5b
mov r3,#0 @ zero final
strb r3,[r9,r1]
mov r0,r9
b 100f
@ display errors
96:
ldr r0,iAdrszMessClose
bl affichageMess
mov r0,#-1 @ error
b 100f
97:
ldr r0,iAdrszMessRead
bl affichageMess
mov r0,#-1 @ error
b 100f
98:
ldr r0,iAdrszMessStat
bl affichageMess
mov r0,#-1 @ error
b 101f
99:
ldr r0,iAdrszMessOpen
bl affichageMess
mov r0,#-1 @ error
b 101f
100:
add sp,sp,r12
add sp,sp,#0x1000
101:
pop {r1-r12,pc}
iAdrszFileName: .int szFileName
iAdrszMessOpen: .int szMessOpen
iAdrszMessRead: .int szMessRead
iAdrszMessStat: .int szMessStat
iAdrszMessClose: .int szMessClose
iAdrsBuffer: .int sBuffer
/******************************************************************/
/* control if letters are diferents */
/******************************************************************/
/* r0 contains the address of the string */
/* r0 return 1 if Ok else return 0 */
wordControl:
push {r1-r4,lr} @ save registers
mov r1,#0 @ init index 1
1:
ldrb r3,[r0,r1] @ load one character
cmp r3,#0x0D @ end word ?
moveq r0,#1 @ yes is ok
beq 100f @ -> end
add r2,r1,#1 @ init index two
2:
ldrb r4,[r0,r2] @ load one character
cmp r4,#0x0D @ end word ?
addeq r1,r1,#1 @ yes increment index 1
beq 1b @ and loop1
cmp r3,r4 @ caracters equals ?
moveq r0,#0 @ yes is not good
beq 100f @ and end
add r2,r2,#1 @ else increment index 2
b 2b @ and loop 2
100:
pop {r1-r4,pc}
/******************************************************************/
/* key sort by insertion sort */
/******************************************************************/
/* r0 contains the address of String */
/* r1 contains the first element */
/* r2 contains the number of element */
/* r3 contains result address */
keySort:
push {r2-r10,lr} @ save registers
ldr r7,iAdrtabPosit
mov r10,r3
mov r3,#0
0: @ init position array and copy key
strb r3,[r7,r3] @ in result array
ldrb r4,[r0,r3]
strb r4,[r10,r3]
add r3,r3,#1
cmp r3,#KEYSIZE
blt 0b
add r3,r1,#1 @ start index i
1: @ start loop
ldrb r4,[r10,r3] @ load value A[i]
ldrb r8,[r7,r3] @ load position
sub r5,r3,#1 @ index j
2:
ldrb r6,[r10,r5] @ load value A[j]
ldrb r9,[r7,r5] @ load position
cmp r6,r4 @ compare value
ble 3f
add r5,#1 @ increment index j
strb r6,[r10,r5] @ store value A[j+1]
strb r9,[r7,r5] @ store position
subs r5,#2 @ j = j - 1
bge 2b @ loop if j >= 0
3:
add r5,#1 @ increment index j
strb r4,[r10,r5] @ store value A[i] in A[j+1]
strb r8,[r7,r5]
add r3,#1 @ increment index i
cmp r3,r2 @ end ?
blt 1b @ no -> loop
ldr r1,iAdrtabPositInv @ inverse position
mov r2,#0 @ index
4:
ldrb r3,[r7,r2] @ load position index
strb r2,[r1,r3] @ store index in position
add r2,r2,#1 @ increment index
cmp r2,#KEYSIZE @ end ?
blt 4b
mov r0,r10
100:
pop {r2-r10,pc}
iAdrtabPosit: .int tabPosit
iAdrtabPositInv: .int tabPositInv
/******************************************************************/
/* text encryption */
/******************************************************************/
/* r0 contains the address of text */
/* r1 contains polybius address
/* r2 contains the key address */
/* r3 contains result buffer address */
encryption:
push {r2-r10,lr} @ save registers
mov r9,r0 @ save text address
mov r8,r3
mov r10,r1 @ save address polybius
mov r0,r2 @ key address
mov r1,#0 @ first character
mov r2,#KEYSIZE @ key length
ldr r3,iAdrsKeyWordSorted @ result address
bl keySort @ sort leters of key
//bl affichageMess @ if you want display sorted key
//ldr r0,iAdrszCarriageReturn
//bl affichageMess
ldr r3,iAdrsBuffer1
mov r5,#0 @ init text index
mov r4,#0 @ init result index
1:
ldrb r0,[r9,r5] @ load a byte to text
cmp r0,#0 @ end ?
beq 4f
mov r6,#0 @ init index polybius
2:
ldrb r7,[r10,r6] @ load character polybius
cmp r7,r0 @ equal ?
beq 3f
add r6,r6,#1 @ increment index
cmp r6,#SIZEC @ not find -> error
bge 99f
b 2b @ and loop
3:
mov r0,r6
bl convPosCode @ convert position in code character
strb r0,[r3,r4] @ line code character
add r4,r4,#1
strb r1,[r3,r4] @ column code character
add r4,r4,#1
add r5,r5,#1 @ increment text index
b 1b
4:
mov r0,#0 @ zero final -> text result
strb r0,[r3,r4]
mov r5,r3
mov r1,#0 @ index position column
mov r7,#0 @ index text
ldr r2,iAdrtabPositInv
5:
ldrb r0,[r2,r1] @ load position text
7: @ loop to characters transposition
ldrb r6,[r5,r0] @ load character
strb r6,[r8,r7] @ store position final
add r7,r7,#1 @ increment final index
add r0,r0,#KEYSIZE @ add size key
cmp r0,r4 @ end ?
blt 7b
add r1,r1,#1 @ add index column
cmp r1,#KEYSIZE @ < key size
blt 5b @ yes -> loop
mov r6,#0 @ zero final
strb r6,[r8,r7]
mov r0,r8 @ return address encrypted text
b 100f
99: @ display error
ldr r0,iAdrszMessErrorChar
bl affichageMess
mov r0,#-1
100:
pop {r2-r10,pc}
iAdrsBuffer1: .int sBuffer1
iAdrsKeyWordSorted: .int sKeyWordSorted
iAdrszMessErrorChar: .int szMessErrorChar
/******************************************************************/
/* text decryption */
/******************************************************************/
/* r0 contains the address of text */
/* r1 contains polybius address
/* r2 contains the key */
/* r3 contains result buffer */
/* r0 return decoded text */
decryption:
push {r1-r12,lr} @ save registers
mov r4,#0
1: @ compute text length
ldrb r5,[r0,r4]
cmp r5,#0
addne r4,r4,#1
bne 1b
mov r12,r0
mov r11,r1
mov r10,r2
mov r9,r3
mov r0,r4 @ compute line number and remainder
mov r1,#KEYSIZE
bl division
mov r8,r2 @ line number
mov r7,r3 @ remainder characters last line
mov r0,r10 @ key address
mov r1,#0 @ first character
mov r2,#KEYSIZE @ size
ldr r3,iAdrsKeyWordSorted @ result address
bl keySort @ sort key
ldr r10,iAdrtabPositInv @ inverse position
mov r2,#0 @ index colonne tabposit
mov r5,#0 @ text index
mov r0,#0 @ index line store text
mov r1,#0 @ counter line
push {r9} @ save final result address
ldr r9,iAdrsBuffer2
1:
ldrb r3,[r10,r2] @ load position
ldrb r6,[r12,r5] @ load text character
add r3,r3,r0 @ compute position with index line
strb r6,[r9,r3] @ store character in good position
add r5,r5,#1 @ increment index text
cmp r5,r4 @ end ?
bge 4f
add r1,r1,#1 @ increment line
cmp r1,r8 @ line < line size
blt 2f
bgt 11f @ line = line size
sub r3,r3,r0 @ restaure position column
cmp r3,r7 @ position < remainder so add character other line
blt 2f
11:
mov r1,#0 @ init ligne
mov r0,#0 @ init line shift
add r2,r2,#1 @ increment index array position inverse
cmp r2,#KEYSIZE @ end ?
movge r2,#0 @ init index
b 3f
2:
add r0,#KEYSIZE
3:
b 1b
4: @ convertir characters with polybius
mov r3,#0
mov r5,#0
pop {r6} @ restaur final address result
5:
mov r0,r11
ldrb r1,[r9,r3] @ load a first character
add r3,r3,#1
ldrb r2,[r9,r3] @ load a 2ieme character
bl decodPosCode @ decode
strb r0,[r6,r5] @ store result in final result
add r5,r5,#1 @ increment final result index
add r3,r3,#1 @ increment index text
cmp r3,r4 @ end ?
blt 5b
mov r0,#0 @ final zero
strb r0,[r6,r5]
mov r0,r6 @ return final result address
100:
pop {r1-r12,pc}
iAdrsBuffer2: .int sBuffer2
/******************************************************************/
/* convertir position en code */
/******************************************************************/
/* r0 contains the position in polybius */
/* r0 return code1 */
/* r1 return code2 */
convPosCode:
push {r2-r4,lr} @ save registers
ldr r4,iAdrszListCharCode
mov r1,#SIZE
bl division
ldrb r0,[r4,r2]
ldrb r1,[r4,r3]
100:
pop {r2-r4,pc}
iAdrszListCharCode: .int szListCharCode
/******************************************************************/
/* convertir code en character */
/******************************************************************/
/* r0 polybius address */
/* r1 code 1 */
/* r2 code 2 */
/* r0 return character */
decodPosCode:
push {r1-r5,lr} @ save registers
ldr r4,iAdrszListCharCode
mov r3,#0
1:
ldrb r5,[r4,r3]
cmp r5,#0
beq 2f
cmp r5,r1
moveq r1,r3
cmp r5,r2
moveq r2,r3
add r3,r3,#1
b 1b
2:
mov r5,#SIZE
mul r1,r5,r1
add r1,r1,r2
ldrb r0,[r0,r1]
100:
pop {r1-r5,pc}
/******************************************************************/
/* shuffle strings algorithme Fisher-Yates */
/******************************************************************/
/* r0 contains the address of the string */
/* r1 contains string length */
/* r2 contains address result string */
shufflestrings:
push {r1-r4,lr} @ save registers
mov r3,#0
1: @ loop copy string in result
ldrb r4,[r0,r3]
strb r4,[r2,r3]
add r3,r3,#1
cmp r3,r1
ble 1b
sub r1,r1,#1 @ last element
2:
mov r0,r1 @ limit random number
bl genereraleas @ call random
ldrb r4,[r2,r1] @ load byte string index loop
ldrb r3,[r2,r0] @ load byte string random index
strb r3,[r2,r1] @ and exchange
strb r4,[r2,r0]
subs r1,r1,#1
cmp r1,#1
bge 2b
100:
pop {r1-r4,pc} @ restaur registers
/***************************************************/
/* Generation random number */
/***************************************************/
/* r0 contains limit */
genereraleas:
push {r1-r4,lr} @ save registers
ldr r4,iAdriGraine
ldr r2,[r4]
ldr r3,iNbDep1
mul r2,r3,r2
ldr r3,iNbDep1
add r2,r2,r3
str r2,[r4] @ save seed for next call
cmp r0,#0
beq 100f
mov r1,r0 @ divisor
mov r0,r2 @ dividende
bl division
mov r0,r3 @ résult = remainder
100: @ end function
pop {r1-r4,pc} @ restaur registers
iAdriGraine: .int iGraine
iNbDep1: .int 0x343FD
iNbDep2: .int 0x269EC3
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"

22
Task/AKS-test-for-primes/Maxima/aks-test-for-primes.maxima Normal file
View file

@ -0,0 +1,22 @@
/* Function that lists coefficients given the exponent */
pol_to_list(n):=if n=0 then [1] else block(pol:expand((x-1)^n),
makelist(numfactor(part(pol,i)),i,1,length(pol)))$
/* Function to expand the polynomial (x-1)^n */
expansion(n):=block(
coeflist:pol_to_list(n),
makelist(x^(length(%%)-i),i,1,length(%%)),
%%*coeflist,
apply("+",%%))$
/* AKS based predicate function */
aks_primep(n):=if n=1 then false else block(sample:expansion(n)-(x^n-1),
makelist(numfactor(part(sample,i)),i,1,length(sample)),
if not member(false,makelist(integerp(%%[i]/n),i,1,length(%%))) then true)$
/* Test cases */
makelist(expansion(i),i,0,7);
block(
makelist(aks_primep(i),i,1,50),
sublist_indices(%%,lambda([x],x=true)));

22
Task/Abstract-type/COBOL/abstract-type.cobol
View file

@ -1,7 +1,9 @@
IDENTIFICATION DIVISION.
INTERFACE-ID. Shape.
PROCEDURE DIVISION.
IDENTIFICATION DIVISION.
METHOD-ID. perimeter.
DATA DIVISION.
LINKAGE SECTION.
@ -9,6 +11,7 @@
PROCEDURE DIVISION RETURNING ret.
END METHOD perimeter.
IDENTIFICATION DIVISION.
METHOD-ID. shape-area.
DATA DIVISION.
LINKAGE SECTION.
@ -19,6 +22,7 @@
END INTERFACE Shape.
IDENTIFICATION DIVISION.
CLASS-ID. Rectangle.
ENVIRONMENT DIVISION.
@ -26,6 +30,7 @@
REPOSITORY.
INTERFACE Shape.
IDENTIFICATION DIVISION.
OBJECT IMPLEMENTS Shape.
DATA DIVISION.
WORKING-STORAGE SECTION.
@ -34,25 +39,30 @@
PROCEDURE DIVISION.
IDENTIFICATION DIVISION.
METHOD-ID. perimeter.
DATA DIVISION.
LINKAGE SECTION.
01 ret USAGE FLOAT-LONG.
PROCEDURE DIVISION RETURNING ret.
COMPUTE ret = width * 2.0 + height * 2.0
GOBACK
.
COMPUTE
ret = width * 2.0 + height * 2.0
END-COMPUTE
GOBACK.
END METHOD perimeter.
IDENTIFICATION DIVISION.
METHOD-ID. shape-area.
DATA DIVISION.
LINKAGE SECTION.
01 ret USAGE FLOAT-LONG.
PROCEDURE DIVISION RETURNING ret.
COMPUTE ret = width * height
GOBACK
.
COMPUTE
ret = width * height
END-COMPUTE
GOBACK.
END METHOD shape-area.
END OBJECT.
END CLASS Rectangle.

15
Task/Abundant-deficient-and-perfect-number-classifications/Julia/abundant-deficient-and-perfect-number-classifications-3.julia Normal file
View file

@ -0,0 +1,15 @@
using Primes
""" Return tuple of (perfect, abundant, deficient) counts from 1 up to nmax """
function per_abu_def_classify(nmax::Int)
results = [0, 0, 0]
for n in 1:nmax
results[sign(sum(divisors(n)) - 2 * n) + 2] += 1
end
return (perfect, abundant, deficient) = results
end
let MAX = 20_000
NPE, NAB, NDE = per_abu_def_classify(MAX)
println("$NPE perfect, $NAB abundant, and $NDE deficient numbers in 1:$MAX.")
end

9
Task/Abundant-deficient-and-perfect-number-classifications/Maxima/abundant-deficient-and-perfect-number-classifications.maxima Normal file
View file

@ -0,0 +1,9 @@
/* Given a number it returns wether it is perfect, deficient or abundant */
number_class(n):=if divsum(n)-n=n then "perfect" else if divsum(n)-n<n then "deficient" else if divsum(n)-n>n then "abundant"$
/* Function that displays the number of each kind below n */
classification_count(n):=block(makelist(number_class(i),i,1,n),
[[length(sublist(%%,lambda([x],x="deficient")))," deficient"],[length(sublist(%%,lambda([x],x="perfect")))," perfect"],[length(sublist(%%,lambda([x],x="abundant")))," abundant"]])$
/* Test case */
classification_count(20000);

12
Task/Address-of-a-variable/COBOL/address-of-a-variable-1.cobol
View file

@ -1,7 +1,7 @@
data division.
working-storage section.
01 ptr usage pointer.
01 var pic x(64).
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ptr USAGE POINTER.
01 var PIC X(64).
procedure division.
set ptr to address of var.
PROCEDURE DIVISION.
SET ptr TO ADDRESS OF var.

25
Task/Address-of-a-variable/COBOL/address-of-a-variable-2.cobol
View file

@ -1,12 +1,17 @@
OCOBOL*> Rosetta Code set address example
*> tectonics: cobc -x setaddr.cob && ./setaddr
program-id. setaddr.
data division.
working-storage section.
01 prealloc pic x(8) value 'somedata'.
01 var pic x(8) based.
procedure division.
set address of var to address of prealloc
display var end-display
goback.
end program setaddr.
IDENTIFICATION DIVISION.
PROGRAM-ID. setaddr.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 prealloc PIC X(8) VALUE 'somedata'.
01 var PIC X(8) BASED.
PROCEDURE DIVISION.
SET ADDRESS OF var TO ADDRESS OF prealloc
DISPLAY var END-DISPLAY
*> 'somedata'
GOBACK.
END PROGRAM setaddr.

64
Task/Almost-prime/Craft-Basic/almost-prime.basic Normal file
View file

@ -0,0 +1,64 @@
for k = 1 to 5
print "k = ", k, ": ",
let e = 2
let c = 0
do
if c < 10 then
let n = e
gosub kprime
if r then
print tab, e,
let c = c + 1
endif
let e = e + 1
endif
loop c < 10
print
next k
end
sub kprime
let f = 0
for i = 2 to n
do
if n mod i = 0 then
if f = k then
let r = 0
return
endif
let f = f + 1
let n = n / i
wait
endif
loop n mod i = 0
next i
let r = f = k
return

32
Task/Almost-prime/FutureBasic/almost-prime.basic Normal file
View file

@ -0,0 +1,32 @@
local fn K_Prime( n as long, k as long ) as BOOL
long f = 0, i = 0
BOOL result
for i = 2 to n
while ( n mod i == 0 )
if f = k then exit fn = NO
f += 1
n /= i
wend
next
result = f = k
end fn = result
long i, c, k
for k = 1 to 5
printf @"k = %ld:\b", k
i = 2
c = 0
while ( c < 10 )
if ( fn K_Prime( i, k ) )
printf @"%4ld\b", i
c++
end if
i++
wend
print
next
HandleEvents

33
Task/Almost-prime/Gambas/almost-prime.gambas Normal file
View file

@ -0,0 +1,33 @@
Public Sub Main()
Dim i As Integer, c As Integer, k As Integer
For k = 1 To 5
Print "k = "; k; " : ";
i = 2
c = 0
While c < 10
If kPrime(i, k) Then
Print Format$(Str$(i), "### ");
c += 1
End If
i += 1
Wend
Print
Next
End
Function kPrime(n As Integer, k As Integer) As Boolean
Dim f As Integer = 0
For i As Integer = 2 To n
While n Mod i = 0
If f = k Then Return False
f += 1
n \= i
Wend
Next
Return f = k
End Function

26
Task/Almost-prime/Odin/almost-prime.odin Normal file
View file

@ -0,0 +1,26 @@
package almostprime
import "core:fmt"
main :: proc() {
i, c, k: int
for k in 1 ..= 5 {
fmt.printf("k = %d:", k)
for i, c := 2, 0; c < 10; i += 1 {
if kprime(i, k) {
fmt.printf(" %v", i)
c += 1
}
}
fmt.printf("\n")
}
}
kprime :: proc(n: int, k: int) -> bool {
p, f: int = 0, 0
n := n
for p := 2; f < k && p * p <= n; p += 1 {
for (0 == n % p) {
n /= p
f += 1
}
}
return f + (n > 1 ? 1 : 0) == k
}

312
Task/Anagrams-Deranged-anagrams/COBOL/anagrams-deranged-anagrams.cobol
View file

@ -1,181 +1,181 @@
******************************************************************
* COBOL solution to Anagrams Deranged challange
* The program was run on OpenCobolIDE
* Input data is stored in file 'Anagrams.txt' on my PC
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. DERANGED.
******************************************************************
* COBOL solution to Anagrams Deranged challange
* The program was run on OpenCobolIDE
* Input data is stored in file 'Anagrams.txt' on my PC
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. DERANGED.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'C:\Both\Rosetta\Anagrams.txt'
ORGANIZATION IS LINE SEQUENTIAL.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'C:\Both\Rosetta\Anagrams.txt'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD PIC X(22).
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD PIC X(22).
WORKING-STORAGE SECTION.
01 SWITCHES.
05 WS-EOF PIC X VALUE 'N'.
05 WS-FND PIC X VALUE 'N'.
05 WS-EXIT PIC X VALUE 'N'.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 WS-EOF PIC X VALUE 'N'.
05 WS-FND PIC X VALUE 'N'.
05 WS-EXIT PIC X VALUE 'N'.
01 COUNTERS.
05 WS-TOT-RECS PIC 9(5) COMP-3 VALUE 0.
05 WS-SEL-RECS PIC 9(5) COMP-3 VALUE 0.
05 WT-REC-NBR PIC 9(5) COMP-3 VALUE 0.
01 COUNTERS.
05 WS-TOT-RECS PIC 9(5) USAGE PACKED-DECIMAL VALUE 0.
05 WS-SEL-RECS PIC 9(5) USAGE PACKED-DECIMAL VALUE 0.
05 WT-REC-NBR PIC 9(5) USAGE PACKED-DECIMAL VALUE 0.
* Extra byte to guarentee a space at end - needed in sort logic.
01 WS-WORD-TEMP PIC X(23).
01 FILLER REDEFINES WS-WORD-TEMP.
05 WS-LETTER OCCURS 23 TIMES PIC X.
77 WS-LETTER-HLD PIC X.
* Extra byte to guarentee a space at end - needed in sort logic.
01 WS-WORD-TEMP PIC X(23).
01 FILLER REDEFINES WS-WORD-TEMP.
05 WS-LETTER OCCURS 23 TIMES PIC X.
77 WS-LETTER-HLD PIC X.
77 WS-WORD-IN PIC X(22).
77 WS-WORD-KEY PIC X(22).
77 WS-WORD-IN PIC X(22).
77 WS-WORD-KEY PIC X(22).
01 WS-WORD-TABLE.
05 WT-RECORD OCCURS 0 to 24000 TIMES
DEPENDING ON WT-REC-NBR
DESCENDING KEY IS WT-WORD-LEN
INDEXED BY WT-IDX.
10 WT-WORD-KEY PIC X(22).
10 WT-WORD-LEN PIC 9(2).
10 WT-ANAGRAM-CNT PIC 9(5) COMP-3.
10 WT-ANAGRAMS OCCURS 6 TIMES.
15 WT-ANAGRAM PIC X(22).
01 WS-WORD-TABLE.
05 WT-RECORD OCCURS 0 to 24000 TIMES
DEPENDING ON WT-REC-NBR
DESCENDING KEY IS WT-WORD-LEN
INDEXED BY WT-IDX.
10 WT-WORD-KEY PIC X(22).
10 WT-WORD-LEN PIC 9(2).
10 WT-ANAGRAM-CNT PIC 9(5) USAGE PACKED-DECIMAL.
10 WT-ANAGRAMS OCCURS 6 TIMES.
15 WT-ANAGRAM PIC X(22).
01 WS-WORD-TEMP1 PIC X(22).
01 FILLER REDEFINES WS-WORD-TEMP1.
05 WS-LETTER1 OCCURS 22 TIMES PIC X.
01 WS-WORD-TEMP1 PIC X(22).
01 FILLER REDEFINES WS-WORD-TEMP1.
05 WS-LETTER1 PIC X OCCURS 22 TIMES.
01 WS-WORD-TEMP2 PIC X(22).
01 FILLER REDEFINES WS-WORD-TEMP2.
05 WS-LETTER2 OCCURS 22 TIMES PIC X.
01 WS-WORD-TEMP2 PIC X(22).
01 FILLER REDEFINES WS-WORD-TEMP2.
05 WS-LETTER2 OCCURS 22 TIMES PIC X.
77 WS-I PIC 99999 COMP-3.
77 WS-J PIC 99999 COMP-3.
77 WS-K PIC 99999 COMP-3.
77 WS-L PIC 99999 COMP-3.
77 WS-BEG PIC 99999 COMP-3.
77 WS-MAX PIC 99999 COMP-3.
77 WS-I PIC 9(5) USAGE PACKED-DECIMAL.
77 WS-J PIC 9(5) USAGE PACKED-DECIMAL.
77 WS-K PIC 9(5) USAGE PACKED-DECIMAL.
77 WS-L PIC 9(5) USAGE PACKED-DECIMAL.
77 WS-BEG PIC 9(5) USAGE PACKED-DECIMAL.
77 WS-MAX PIC 9(5) USAGE PACKED-DECIMAL.
PROCEDURE DIVISION.
000-MAIN.
PERFORM 100-INITIALIZE.
PERFORM 200-PROCESS-RECORD
UNTIL WS-EOF = 'Y'.
SORT WT-RECORD ON DESCENDING KEY WT-WORD-LEN.
PERFORM 500-FIND-DERANGED.
PERFORM 900-TERMINATE.
STOP RUN.
PROCEDURE DIVISION.
000-MAIN.
PERFORM 100-INITIALIZE.
PERFORM 200-PROCESS-RECORD UNTIL WS-EOF = 'Y'.
SORT WT-RECORD ON DESCENDING KEY WT-WORD-LEN.
PERFORM 500-FIND-DERANGED.
PERFORM 900-TERMINATE.
STOP RUN.
100-INITIALIZE.
OPEN INPUT IN-FILE.
PERFORM 150-READ-RECORD.
100-INITIALIZE.
OPEN INPUT IN-FILE.
PERFORM 150-READ-RECORD.
150-READ-RECORD.
READ IN-FILE INTO WS-WORD-IN
AT END
MOVE 'Y' TO WS-EOF
NOT AT END
COMPUTE WS-TOT-RECS = WS-TOT-RECS + 1
END-READ.
150-READ-RECORD.
READ IN-FILE INTO WS-WORD-IN
AT END
MOVE 'Y' TO WS-EOF
NOT AT END
COMPUTE WS-TOT-RECS = WS-TOT-RECS + 1
END-READ.
200-PROCESS-RECORD.
IF WS-WORD-IN IS ALPHABETIC
COMPUTE WS-SEL-RECS = WS-SEL-RECS + 1
MOVE WS-WORD-IN TO WS-WORD-TEMP
PERFORM 300-SORT-WORD
MOVE WS-WORD-TEMP TO WS-WORD-KEY
PERFORM 400-ADD-TO-TABLE
END-IF.
200-PROCESS-RECORD.
IF WS-WORD-IN IS ALPHABETIC
COMPUTE WS-SEL-RECS = WS-SEL-RECS + 1 END-COMPUTE
MOVE WS-WORD-IN TO WS-WORD-TEMP
PERFORM 300-SORT-WORD
MOVE WS-WORD-TEMP TO WS-WORD-KEY
PERFORM 400-ADD-TO-TABLE
END-IF.
PERFORM 150-READ-RECORD.
PERFORM 150-READ-RECORD.
* bubble sort:
300-SORT-WORD.
PERFORM VARYING WS-MAX FROM 1 BY 1
UNTIL WS-LETTER(WS-MAX) = SPACE
END-PERFORM.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I = WS-MAX
PERFORM VARYING WS-J FROM WS-I BY 1
UNTIL WS-J > WS-MAX - 1
IF WS-LETTER(WS-J) < WS-LETTER(WS-I) THEN
MOVE WS-LETTER(WS-I) TO WS-LETTER-HLD
MOVE WS-LETTER(WS-J) TO WS-LETTER(WS-I)
MOVE WS-LETTER-HLD TO WS-LETTER(WS-J)
END-IF
END-PERFORM
END-PERFORM.
* bubble sort:
300-SORT-WORD.
PERFORM VARYING WS-MAX FROM 1 BY 1
UNTIL WS-LETTER(WS-MAX) = SPACE
END-PERFORM.
400-ADD-TO-TABLE.
SET WT-IDX TO 1.
SEARCH WT-RECORD
AT END
PERFORM 420-ADD-RECORD
WHEN WT-WORD-KEY(WT-IDX) = WS-WORD-KEY
PERFORM 440-UPDATE-RECORD
END-SEARCH.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I = WS-MAX
PERFORM VARYING WS-J FROM WS-I BY 1
UNTIL WS-J > WS-MAX - 1
IF WS-LETTER(WS-J) < WS-LETTER(WS-I) THEN
MOVE WS-LETTER(WS-I) TO WS-LETTER-HLD
MOVE WS-LETTER(WS-J) TO WS-LETTER(WS-I)
MOVE WS-LETTER-HLD TO WS-LETTER(WS-J)
END-IF
END-PERFORM
END-PERFORM.
420-ADD-RECORD.
ADD 1 To WT-REC-NBR.
MOVE WS-WORD-KEY TO WT-WORD-KEY(WT-REC-NBR).
COMPUTE WT-WORD-LEN(WT-REC-NBR) = WS-MAX - 1 END-COMPUTE.
MOVE 1 TO WT-ANAGRAM-CNT(WT-REC-NBR).
MOVE WS-WORD-IN TO
WT-ANAGRAM(WT-REC-NBR, WT-ANAGRAM-CNT(WT-REC-NBR)).
400-ADD-TO-TABLE.
SET WT-IDX TO 1.
SEARCH WT-RECORD
AT END
PERFORM 420-ADD-RECORD
WHEN WT-WORD-KEY(WT-IDX) = WS-WORD-KEY
PERFORM 440-UPDATE-RECORD
END-SEARCH.
440-UPDATE-RECORD.
ADD 1 TO WT-ANAGRAM-CNT(WT-IDX).
MOVE WS-WORD-IN TO
WT-ANAGRAM(WT-IDX, WT-ANAGRAM-CNT(WT-IDX)).
420-ADD-RECORD.
ADD 1 To WT-REC-NBR.
MOVE WS-WORD-KEY TO WT-WORD-KEY(WT-REC-NBR).
COMPUTE WT-WORD-LEN(WT-REC-NBR) = WS-MAX - 1.
MOVE 1 TO WT-ANAGRAM-CNT(WT-REC-NBR).
MOVE WS-WORD-IN TO
WT-ANAGRAM(WT-REC-NBR, WT-ANAGRAM-CNT(WT-REC-NBR)).
500-FIND-DERANGED.
PERFORM VARYING WS-I FROM 1 BY 1
UNTIL WS-I > WT-REC-NBR OR WS-FND = 'Y'
PERFORM VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WT-ANAGRAM-CNT(WS-I) - 1 OR WS-FND = 'Y'
COMPUTE WS-BEG = WS-J + 1 END-COMPUTE
PERFORM VARYING WS-K FROM WS-BEG BY 1
UNTIL WS-K > WT-ANAGRAM-CNT(WS-I) OR WS-FND = 'Y'
MOVE WT-ANAGRAM(WS-I, WS-J) TO WS-WORD-TEMP1
MOVE WT-ANAGRAM(WS-I, WS-K) To WS-WORD-TEMP2
PERFORM 650-CHECK-DERANGED
END-PERFORM
END-PERFORM
END-PERFORM.
440-UPDATE-RECORD.
ADD 1 TO WT-ANAGRAM-CNT(WT-IDX).
MOVE WS-WORD-IN TO
WT-ANAGRAM(WT-IDX, WT-ANAGRAM-CNT(WT-IDX)).
650-CHECK-DERANGED.
MOVE 'N' TO WS-EXIT.
PERFORM VARYING WS-L FROM 1 BY 1
UNTIL WS-L > WT-WORD-LEN(WS-I) OR WS-EXIT = 'Y'
IF WS-LETTER1(WS-L) = WS-LETTER2(WS-L)
MOVE 'Y' TO WS-EXIT
END-IF
END-PERFORM.
IF WS-EXIT = 'N'
DISPLAY
WS-WORD-TEMP1(1:WT-WORD-LEN(WS-I)) ' ' WS-WORD-TEMP2
END-DISPLAY
MOVE 'Y' TO WS-FND
END-IF.
500-FIND-DERANGED.
PERFORM VARYING WS-I FROM 1 BY 1
UNTIL WS-I > WT-REC-NBR OR WS-FND = 'Y'
PERFORM VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WT-ANAGRAM-CNT(WS-I) - 1 OR WS-FND = 'Y'
COMPUTE WS-BEG = WS-J + 1
PERFORM VARYING WS-K FROM WS-BEG BY 1
UNTIL WS-K > WT-ANAGRAM-CNT(WS-I) OR WS-FND = 'Y'
MOVE WT-ANAGRAM(WS-I, WS-J) TO WS-WORD-TEMP1
MOVE WT-ANAGRAM(WS-I, WS-K) To WS-WORD-TEMP2
PERFORM 650-CHECK-DERANGED
END-PERFORM
END-PERFORM
END-PERFORM.
900-TERMINATE.
DISPLAY 'RECORDS READ: ' WS-TOT-RECS.
DISPLAY 'RECORDS SELECTED ' WS-SEL-RECS.
DISPLAY 'RECORD KEYS: ' WT-REC-NBR.
CLOSE IN-FILE.
650-CHECK-DERANGED.
MOVE 'N' TO WS-EXIT.
PERFORM VARYING WS-L FROM 1 BY 1
UNTIL WS-L > WT-WORD-LEN(WS-I) OR WS-EXIT = 'Y'
IF WS-LETTER1(WS-L) = WS-LETTER2(WS-L)
MOVE 'Y' TO WS-EXIT
END-PERFORM.
IF WS-EXIT = 'N'
DISPLAY WS-WORD-TEMP1(1:WT-WORD-LEN(WS-I))
' '
WS-WORD-TEMP2
MOVE 'Y' TO WS-FND
END-IF.
END PROGRAM DERANGED.
900-TERMINATE.
DISPLAY 'RECORDS READ: ' WS-TOT-RECS.
DISPLAY 'RECORDS SELECTED ' WS-SEL-RECS.
DISPLAY 'RECORD KEYS: ' WT-REC-NBR.
CLOSE IN-FILE.
*> OUTPUT:
*> OUTPUT:
*> excitation intoxicate
*> RECORDS READ: 25104
*> RECORDS SELECTED 24978
*> RECORD KEYS: 23441
*> excitation intoxicate
*> RECORDS READ: 25104
*> RECORDS SELECTED 24978
*> RECORD KEYS: 23441
*> BUBBLE SORT REFERENCE:
*> https://mainframegeek.wordpress.com/tag/bubble-sort-in-cobol
*> BUBBLE SORT REFERENCE:
*> https://mainframegeek.wordpress.com/tag/bubble-sort-in-cobol

46
Task/Animate-a-pendulum/FutureBasic/animate-a-pendulum.basic Normal file
View file

@ -0,0 +1,46 @@
void local fn BuildWindow
window 1, @"Animated Pendulum in FutureBasic", ( 0, 0, 640, 400 )
WindowSetBackgroundColor( 1, fn ColorBlack )
WindowSetMinSize( 1, fn CGSizeMake( 640, 400 ) )
WindowSetMaxSize( 1, fn CGSizeMake( 640, 400 ) )
end fn
local fn AnimatedPendulum
block double theta, gravity, length, accel, speed, weight, tempo, px, py, bx, by
block ColorRef color = fn ColorWithRGB( 0.164, 0.793, 0.075, 1.0 )
theta = pi/2.0 // Denominator of 2.0 = 180-degree swing, < 2.0 narrows inscribed arc, > 2.0 widens it.
gravity = 9.90 // Adjusts effect of gravity on swing. Smaller values slow arc swing.
length = 0.95 // Tweak for length of pendulum arm
speed = 0 // Zero this or you get a propellor!
px = 320 // Pivot horizontal center x point (half window width)
py = 30 // Pivot y center y point from top
weight = 42 // Diameter of pendulum weight
tempo = 75 // Smaller value increases pendulum tempo, larger value slows it.
timerbegin, 0.02, YES
bx = px + length * 300 * sin(theta) // Pendulum bottom x point
by = py - length * 300 * cos(theta) // Pendulum bottom y point
cls
pen 6.0, color
line px, py to bx, by
oval fill bx -weight/2, by -weight/2, weight, weight, color // Traveling weight
pen 4.0
oval fill 313, 20, 16, 16, fn ColorGray // Top center point
accel = gravity * sin(theta) / length / tempo
speed += accel / tempo
theta += speed
timerEnd
end fn
void local fn DoDialog( ev as long, tag as long, wnd as long )
select ( ev )
case _windowWillClose : end
end select
end fn
on dialog fn DoDialog
fn BuildWindow
fn AnimatedPendulum
HandleEvents

45
Task/Append-a-record-to-the-end-of-a-text-file/FutureBasic/append-a-record-to-the-end-of-a-text-file.basic Normal file
View file

@ -0,0 +1,45 @@
local fn AppendRecordToFile( pwStr as CFStringRef, url as CFURLRef ) as BOOL
ErrorRef err = NULL
BOOL success = YES
CFDataRef pwData = fn StringData( pwStr, NSUTF8StringEncoding )
FileHandleRef fh = fn FileHandleForWritingToURL( url, @err )
if ( err )
success = fn FileManagerFileExistsAtURL( url )
if success == NO then fn FileManagerCreateFileAtURL( url, pwData, NULL ) : success = YES : exit fn
end if
success = fn FileHandleSeekToEnd( fh, NULL, @err )
if success == NO then print fn ErrorLocalizedDescription( err ) : exit fn
success = fn FileHandleWriteData( fh, pwData, @err )
if success == NO then print fn ErrorLocalizedDescription( err ) : exit fn
success = fn FileHandleClose( fh, @err )
if success == NO then print fn ErrorLocalizedDescription( err ) : exit fn
end fn = success
local fn ReadFileRecords( url as CFURLRef )
ErrorRef err = NULL
CFDataRef pwData = fn DataWithContentsOfURL( url, NSDataReadingMappedIfSafe, @err )
if err then print fn ErrorLocalizedDescription( err ) : exit fn
print fn StringWithData( pwData, NSUTF8StringEncoding )
end fn
local fn ProcessRecords
BOOL success = NO
CFURLRef desktopURL = fn FileManagerURLForDirectory( NSDesktopDirectory, NSUserDomainMask )
CFURLRef url = fn URLByAppendingPathComponent( desktopURL, @"passwords.txt" )
CFArrayRef pwRecords = @[@"account:password:UID:GID:fullname,office,extension,homephone,email:directory:shell\n",¬
@"jsmith:x:1001:1000:Joe Smith,Room 1007,(234)555-8917,(234)555-0077,jsmith@rosettacode.org:/home/jsmith:/bin/bash\n",¬
@"jdoe:x:1002:1000:Jane Doe,Room 1004,(234)555-8914,(234)555-0044,jdoe@rosettacode.org:/home/jdoe:/bin/bash\n"]
NSUInteger i, count = len(pwRecords)
for i = 0 to count - 1
success = fn AppendRecordToFile( pwRecords[i], url )
if success then printf @"Record appended to file." else printf @"Failed to append record."
next
fn ReadFileRecords( url )
end fn
fn ProcessRecords
HandleEvents

37
Task/Apply-a-callback-to-an-array/COBOL/apply-a-callback-to-an-array.cobol
View file

@ -1,23 +1,20 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. Map.
>>SOURCE FORMAT IS FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. map.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Table-Size CONSTANT 30.
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.
LOCAL-STORAGE SECTION.
01 I USAGE UNSIGNED-INT.
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.
LINKAGE SECTION.
01 Table-Param.
03 Table-Values USAGE COMP-2 OCCURS Table-Size TIMES.
01 Func-Id PIC X(30).
PROCEDURE DIVISION USING Table-Param Func-Id.
PERFORM VARYING I FROM 1 BY 1 UNTIL Table-Size < I
CALL Func-Id USING BY REFERENCE Table-Values (I)
END-PERFORM
GOBACK
.
END PROGRAM map.

23
Task/Arithmetic-Integer/LDPL/arithmetic-integer.ldpl Normal file
View file

@ -0,0 +1,23 @@
data:
x is number
y is number
result is number
procedure:
display "Enter x: "
accept x
display "Enter y: "
accept y
add x and y in result
display "x + y = " result lf
subtract y from x in result
display "x - y = " result lf
multiply x by y in result
display "x * y = " result lf
divide x by y in result # There is no integer division but
floor result # floor rounds toward negative infinity
display "x / y = " result lf
modulo x by y in result
display "x % y = " result lf # Returns the sign of the 2nd argument
raise x to y in result
display "x ^ y = " result lf

3
Task/Arithmetic-Rational/00-TASK.txt
View file

@ -15,7 +15,8 @@ Finally test the operators:
Use the new type '''frac''' to find all [[Perfect Numbers|perfect numbers]] less than 2<sup>19</sup> by summing the reciprocal of the factors.
;Related task:
;Related tasks:
* &nbsp; [[Perfect Numbers]]
* &nbsp; [[Check Machin-like formulas]]
<br><br>

470
Task/Arithmetic-evaluation/Elena/arithmetic-evaluation.elena
View file

@ -4,338 +4,340 @@ import extensions'text;
class Token
{
object theValue;
object _value;
rprop int Level;
int Level : rprop;
constructor new(int level)
{
theValue := new StringWriter();
Level := level + 9;
}
constructor new(int level)
{
_value := new StringWriter();
Level := level + 9;
}
append(ch)
{
theValue.write(ch)
}
append(ch)
{
_value.write(ch)
}
Number = theValue.toReal();
Number = _value.toReal();
}
class Node
{
prop object Left;
prop object Right;
rprop int Level;
object Left : prop;
object Right : prop;
int Level : rprop;
constructor new(int level)
{
Level := level
}
constructor new(int level)
{
Level := level
}
}
class SummaryNode : Node
{
constructor new(int level)
<= new(level + 1);
constructor new(int level)
<= super new(level + 1);
Number = Left.Number + Right.Number;
Number = Left.Number + Right.Number;
}
class DifferenceNode : Node
{
constructor new(int level)
<= new(level + 1);
constructor new(int level)
<= super new(level + 1);
Number = Left.Number - Right.Number;
Number = Left.Number - Right.Number;
}
class ProductNode : Node
{
constructor new(int level)
<= new(level + 2);
constructor new(int level)
<= super new(level + 2);
Number = Left.Number * Right.Number;
Number = Left.Number * Right.Number;
}
class FractionNode : Node
{
constructor new(int level)
<= new(level + 2);
constructor new(int level)
<= super new(level + 2);
Number = Left.Number / Right.Number;
Number = Left.Number / Right.Number;
}
class Expression
{
rprop int Level;
prop object Top;
int Level :rprop;
object Top :prop;
constructor new(int level)
{
Level := level
}
constructor new(int level)
{
Level := level
}
Right
{
get() = Top;
object Right
{
get() = Top;
set(object node)
{
Top := node
}
}
set(object node)
{
Top := node
}
}
get Number() => Top;
get Number() => Top;
}
singleton operatorState
{
eval(ch)
{
ch =>
$40 { // (
^ __target.newBracket().gotoStarting()
}
: {
^ __target.newToken().append(ch).gotoToken()
}
}
eval(ch)
{
ch =>
$40 { // (
^ weak self.newBracket().gotoStarting()
}
: {
^ weak self.newToken().append(ch).gotoToken()
}
}
}
singleton tokenState
{
eval(ch)
{
ch =>
$41 { // )
^ __target.closeBracket().gotoToken()
}
$42 { // *
^ __target.newProduct().gotoOperator()
}
$43 { // +
^ __target.newSummary().gotoOperator()
}
$45 { // -
^ __target.newDifference().gotoOperator()
}
$47 { // /
^ __target.newFraction().gotoOperator()
}
: {
^ __target.append:ch
}
}
eval(ch)
{
ch =>
$41 { // )
^ weak self.closeBracket().gotoToken()
}
$42 { // *
^ weak self.newProduct().gotoOperator()
}
$43 { // +
^ weak self.newSummary().gotoOperator()
}
$45 { // -
^ weak self.newDifference().gotoOperator()
}
$47 { // /
^ weak self.newFraction().gotoOperator()
}
: {
^ weak self.append:ch
}
}
}
singleton startState
{
eval(ch)
{
ch =>
$40 { // (
^ __target.newBracket().gotoStarting()
}
$45 { // -
^ __target.newToken().append("0").newDifference().gotoOperator()
}
: {
^ __target.newToken().append:ch.gotoToken()
}
}
eval(ch)
{
ch =>
$40 { // (
^ weak self.newBracket().gotoStarting()
}
$45 { // -
^ weak self.newToken().append("0").newDifference().gotoOperator()
}
: {
^ weak self.newToken().append:ch.gotoToken()
}
}
}
class Scope
{
object theState;
int theLevel;
object theParser;
object theToken;
object theExpression;
object _state;
int _level;
object _parser;
object _token;
object _expression;
constructor new(parser)
{
theState := startState;
theLevel := 0;
theExpression := Expression.new(0);
theParser := parser
}
constructor new(parser)
{
_state := startState;
_level := 0;
_expression := Expression.new(0);
_parser := parser
}
newToken()
{
theToken := theParser.appendToken(theExpression, theLevel)
}
newToken()
{
_token := _parser.appendToken(_expression, _level)
}
newSummary()
{
theToken := nil;
newSummary()
{
_token := nil;
theParser.appendSummary(theExpression, theLevel)
}
_parser.appendSummary(_expression, _level)
}
newDifference()
{
theToken := nil;
newDifference()
{
_token := nil;
theParser.appendDifference(theExpression, theLevel)
}
_parser.appendDifference(_expression, _level)
}
newProduct()
{
theToken := nil;
newProduct()
{
_token := nil;
theParser.appendProduct(theExpression, theLevel)
}
_parser.appendProduct(_expression, _level)
}
newFraction()
{
theToken := nil;
newFraction()
{
_token := nil;
theParser.appendFraction(theExpression, theLevel)
}
_parser.appendFraction(_expression, _level)
}
newBracket()
{
theToken := nil;
newBracket()
{
_token := nil;
theLevel := theLevel + 10;
_level := _level + 10;
theParser.appendSubexpression(theExpression, theLevel)
}
_parser.appendSubexpression(_expression, _level)
}
closeBracket()
{
if (theLevel < 10)
{ InvalidArgumentException.new:"Invalid expression".raise() };
closeBracket()
{
if (_level < 10)
{ InvalidArgumentException.new:"Invalid expression".raise() };
theLevel := theLevel - 10
}
_level := _level - 10
}
append(ch)
{
if(ch >= $48 && ch < $58)
{
theToken.append:ch
}
else
{
InvalidArgumentException.new:"Invalid expression".raise()
}
}
append(ch)
{
if(ch >= $48 && ch < $58)
{
_token.append:ch
}
else
{
InvalidArgumentException.new:"Invalid expression".raise()
}
}
append(string s)
{
s.forEach:(ch){ self.append:ch }
}
append(string s)
{
s.forEach:(ch){ self.append:ch }
}
gotoStarting()
{
theState := startState
}
gotoStarting()
{
_state := startState
}
gotoToken()
{
theState := tokenState
}
gotoToken()
{
_state := tokenState
}
gotoOperator()
{
theState := operatorState
}
gotoOperator()
{
_state := operatorState
}
get Number() => theExpression;
get Number() => _expression;
dispatch() => theState;
dispatch() => _state;
}
class Parser
{
appendToken(object expression, int level)
{
var token := Token.new(level);
appendToken(object expression, int level)
{
var token := Token.new(level);
expression.Top := self.append(expression.Top, token);
expression.Top := self.append(expression.Top, token);
^ token
}
^ token
}
appendSummary(object expression, int level)
{
expression.Top := self.append(expression.Top, SummaryNode.new(level))
}
appendSummary(object expression, int level)
{
var t := expression.Top;
appendDifference(object expression, int level)
{
expression.Top := self.append(expression.Top, DifferenceNode.new(level))
}
expression.Top := self.append(/*expression.Top*/t, SummaryNode.new(level))
}
appendProduct(object expression, int level)
{
expression.Top := self.append(expression.Top, ProductNode.new(level))
}
appendDifference(object expression, int level)
{
expression.Top := self.append(expression.Top, DifferenceNode.new(level))
}
appendFraction(object expression, int level)
{
expression.Top := self.append(expression.Top, FractionNode.new(level))
}
appendProduct(object expression, int level)
{
expression.Top := self.append(expression.Top, ProductNode.new(level))
}
appendSubexpression(object expression, int level)
{
expression.Top := self.append(expression.Top, Expression.new(level))
}
appendFraction(object expression, int level)
{
expression.Top := self.append(expression.Top, FractionNode.new(level))
}
append(lastNode, newNode)
{
if(nil == lastNode)
{ ^ newNode };
appendSubexpression(object expression, int level)
{
expression.Top := self.append(expression.Top, Expression.new(level))
}
if (newNode.Level <= lastNode.Level)
{ newNode.Left := lastNode; ^ newNode };
append(object lastNode, object newNode)
{
if(nil == lastNode)
{ ^ newNode };
var parent := lastNode;
var current := lastNode.Right;
while (nil != current && newNode.Level > current.Level)
{ parent := current; current := current.Right };
if (newNode.Level <= lastNode.Level)
{ newNode.Left := lastNode; ^ newNode };
if (nil == current)
{
parent.Right := newNode
}
else
{
newNode.Left := current; parent.Right := newNode
};
var parent := lastNode;
var current := lastNode.Right;
while (nil != current && newNode.Level > current.Level)
{ parent := current; current := current.Right };
^ lastNode
}
if (nil == current)
{
parent.Right := newNode
}
else
{
newNode.Left := current; parent.Right := newNode
};
run(text)
{
var scope := Scope.new(self);
^ lastNode
}
text.forEach:(ch){ scope.eval:ch };
run(text)
{
var scope := Scope.new(self);
^ scope.Number
}
text.forEach:(ch){ scope.eval:ch };
^ scope.Number
}
}
public program()
{
var text := new StringWriter();
var parser := new Parser();
var text := new StringWriter();
var parser := new Parser();
while (console.readLine().saveTo(text).Length > 0)
{
try
{
console.printLine("=",parser.run:text)
}
catch(Exception e)
{
console.writeLine:"Invalid Expression"
};
while (console.readLine().writeTo(text).Length > 0)
{
try
{
console.printLine("=",parser.run:text)
}
catch(Exception e)
{
console.writeLine:"Invalid Expression"
};
text.clear()
}
text.clear()
}
}

13
Task/Arithmetic-evaluation/Elixir/arithmetic-evaluation.elixir Normal file
View file

@ -0,0 +1,13 @@
defmodule Ast do
def main do
expr = IO.gets("Give an expression:\n") |> String.Chars.to_string |> String.trim
case Code.string_to_quoted(expr) do
{:ok, ast} ->
IO.puts("AST is: " <> inspect(ast))
{result, _} = Code.eval_quoted(ast)
IO.puts("Result = #{result}")
{:error, {_meta, message_info, _token}} ->
IO.puts(message_info)
end
end
end

32
Task/Arithmetic-evaluation/FutureBasic/arithmetic-evaluation.basic Normal file
View file

@ -0,0 +1,32 @@
_window = 1
begin enum 1
_expressionLabel
_expressionFld
_resultLabel
end enum
void local fn BuildUI
editmenu 1
window _window, @"Arithmetic Evaluation", (0,0,522,61)
textlabel _expressionLabel, @"Expression:", (18,23,74,16)
textfield _expressionFld,,, (98,20,300,21)
textlabel _resultLabel,, (404,23,100,16)
WindowMakeFirstResponder( _window, _expressionFld )
end fn
void local fn EvaluateExpression( string as CFStringRef )
ExpressionRef expression = fn ExpressionWithFormat( string )
textlabel _resultlabel, fn StringWithFormat( @"= %@", fn ExpressionValueWithObject( expression, NULL, NULL ) )
end fn
void local fn DoDialog( ev as long, tag as long )
select ( ev )
case _btnClick : fn EvaluateExpression( textfield(tag) )
end select
end fn
fn BuildUI
on dialog fn DoDialog
HandleEvents

2
Task/Arithmetic-geometric-mean/Dc/arithmetic-geometric-mean.dc Normal file
View file

@ -0,0 +1,2 @@
>>> 200 k ? sbsa [lalb +2/ lalb *vsb dsa lb - 0!=:]ds:xlap
?> 1 1 2 v /

13
Task/Array-concatenation/LDPL/array-concatenation.ldpl Normal file
View file

@ -0,0 +1,13 @@
include "std-list.ldpl"
data:
arr1 is number list
arr2 is number list
procedure:
push 1 to arr1
push 2 to arr1
push 3 to arr2
push 4 to arr2
append list arr2 to list arr1
display list arr1

15
Task/Array-concatenation/Odin/array-concatenation-1.odin Normal file
View file

@ -0,0 +1,15 @@
package main
import "core:fmt"
import "core:slice"
main :: proc() {
x: [3]int = {1, 2, 3}
y: [3]int = {4, 5, 6}
xy: [len(x) + len(y)]int
copy(xy[:], x[:])
copy(xy[len(x):], y[:])
fmt.println(xy)
}

14
Task/Array-concatenation/Odin/array-concatenation-2.odin Normal file
View file

@ -0,0 +1,14 @@
package main
import "core:fmt"
import "core:slice"
main :: proc() {
x: [3]int = {1, 2, 3}
y: [3]int = {4, 5, 6}
xy := slice.concatenate([][]int{x[:], y[:]})
defer delete(xy)
fmt.println(xy)
}

1
Task/Array-length/Dt/array-length.dt Normal file
View file

@ -0,0 +1 @@
[ "apple" "orange" ] len

2
Task/Array-length/Elm/array-length.elm
View file

@ -6,5 +6,5 @@ main =
["apple", "orange"]
|> Array.fromList
|> Array.length
|> Basics.toString
|> String.fromInt
|> Html.text

9
Task/Array-length/LDPL/array-length.ldpl Normal file
View file

@ -0,0 +1,9 @@
data:
fruits is text list
len is number
procedure:
push "apple" to fruits
push "orange" to fruits
get length of fruits in len
display len lf

74
Task/Arrays/FutureBasic/arrays.basic
View file

@ -1,4 +1,4 @@
window 1, @"FutureBasic Arrays"
window 1, @"FutureBasic Arrays", (0,0,480,450)
begin globals
dynamic gA1(10) as long
@ -58,31 +58,31 @@ void local fn CTypeDynamic
gA1(1) = 38
gA1(10) = 67
for i = 0 to fn DynamicNextElement( dynamic(gA1) ) - 1
print gA1(i),
next
print
print gA1(i),
next
print
gA1(5) = 19
gA1(10) = 22
for i = 0 to fn DynamicNextElement( dynamic(gA1) ) - 1
print gA1(i),
next
print
gA1(5) = 19
gA1(10) = 22
for i = 0 to fn DynamicNextElement( dynamic(gA1) ) - 1
print gA1(i),
next
print
gA2(0) = "Kilo"
gA2(1) = "Lima"
gA2(5) = "Mike"
for i = 0 to fn DynamicNextElement( dynamic(gA2) ) - 1
print gA2(i),
next
print
gA2(0) = "Kilo"
gA2(1) = "Lima"
gA2(5) = "Mike"
for i = 0 to fn DynamicNextElement( dynamic(gA2) ) - 1
print gA2(i),
next
print
gA2(1) = "November"
gA2(6) = "Oscar"
for i = 0 to fn DynamicNextElement( dynamic(gA2) ) - 1
print gA2(i),
next
print : print
gA2(1) = "November"
gA2(6) = "Oscar"
for i = 0 to fn DynamicNextElement( dynamic(gA2) ) - 1
print gA2(i),
next
print : print
end fn
void local fn CoreFoundationImmutable
@ -163,6 +163,33 @@ void local fn CoreFoundationMutableDynamic
for i = 0 to len(a1) - 1
print a1[i],
next
print : print
end fn
void local fn FB_MDA
long i
text ,, fn ColorGray
print @"// FB MDA - mutable, dynamic, multi-dimensional"
text
mda_add = @"Alpha"
mda_add = @"Romeo"
mda_add = @"Mike"
for i = 0 to mda_count - 1
print mda(i),
next
print
mda_swap(0),(2)
mda(1) = @"Delta"
for i = 0 to mda_count - 1
print mda(i),
next
end fn
fn CType
@ -170,5 +197,6 @@ fn CTypeDynamic
fn CoreFoundationImmutable
fn CoreFoundationMutableFixedLength
fn CoreFoundationMutableDynamic
fn FB_MDA
HandleEvents

21
Task/Arrays/LDPL/arrays.ldpl Normal file
View file

@ -0,0 +1,21 @@
data:
myArray is list of numbers
procedure:
# add elements
push 1 to myArray
push 2 to myArray
push 3 to myArray
# access elements
display myArray:0 lf
# store elements
store 99 in myArray:0
# remove elements
remove element at 1 from myArray
delete last element of myArray
# clear array
clear myArray

50
Task/Atomic-updates/FutureBasic/atomic-updates.basic Normal file
View file

@ -0,0 +1,50 @@
local fn PopulateArrayWithRandomNumbers
NSUInteger i
for i = 0 to 9
mda (i) = rnd(90)
next
end fn
local fn Display( title as CFStringRef ) as NSUInteger
NSUInteger i, worth = 0
CFStringRef comma = @","
printf @"%@ [\b", title
for i = 0 to 9
worth += mda_integer (i)
if i == 9 then comma = @""
printf @"%2lu%@\b", mda_integer (i), comma
next
printf @"] Sum = %lu", worth
end fn = worth
local fn Flatten( f as NSUInteger )
NSUInteger i, f1 = int((f / 10) + .5 ), f2 = 0, temp
for i = 0 to 9
mda (i) = f1
f2 += f1
next
temp = mda_integer (9)
mda (9) = temp + f - f2
end fn
local fn Transfer( a1 as NSUInteger, a2 as NSUInteger )
NSUInteger t, temp = int( rnd( mda_integer ( a1 ) ) )
t = mda_integer ( a1 ) : mda ( a1 ) = t -temp
t = mda_integer ( a2 ) : mda ( a2 ) = t +temp
end fn
NSUInteger a, i
random
fn PopulateArrayWithRandomNumbers
a = fn Display( @" Initial array:" )
fn Flatten( a )
a = fn Display( @" Current values:" )
fn Transfer( 3, 5 )
fn Display( @" 19 from 3 to 5:" )
HandleEvents

2
Task/Averages-Arithmetic-mean/Elena/averages-arithmetic-mean.elena
View file

@ -11,7 +11,7 @@ extension op
while (enumerator.next())
{
sum += enumerator.get();
sum += *enumerator;
count += 1;
};

152
Task/Averages-Median/Craft-Basic/averages-median.basic Normal file
View file

@ -0,0 +1,152 @@
define limit = 10, iterations = 6
define iteration, size, middle, plusone
define point, top, high, low, pivot
dim list[limit]
dim stack[limit]
for iteration = 1 to iterations
gosub fill
gosub median
next iteration
end
sub fill
print "list: ",
erasearray list
let size = int(rnd * limit) + 1
if size <= 2 then
let size = 3
endif
for i = 0 to size - 1
let list[i] = rnd * 1000 + rnd
print list[i],
gosub printcomma
next i
return
sub median
gosub sort
print newline, "size: ", size, tab,
let middle = int((size - 1)/ 2)
print "middle: ", middle + 1, tab,
if size mod 2 then
print "median: ", list[middle]
else
let plusone = middle + 1
print "median: ", (list[middle] + list[plusone]) / 2
endif
print
return
sub sort
let low = 0
let high = size - 1
let top = -1
let top = top + 1
let stack[top] = low
let top = top + 1
let stack[top] = high
do
if top < 0 then
break
endif
let high = stack[top]
let top = top - 1
let low = stack[top]
let top = top - 1
let i = low - 1
for j = low to high - 1
if list[j] <= list[high] then
let i = i + 1
let t = list[i]
let list[i] = list[j]
let list[j] = t
endif
next j
let point = i + 1
let t = list[point]
let list[point] = list[high]
let list[high] = t
let pivot = i + 1
if pivot - 1 > low then
let top = top + 1
let stack[top] = low
let top = top + 1
let stack[top] = pivot - 1
endif
if pivot + 1 < high then
let top = top + 1
let stack[top] = pivot + 1
let top = top + 1
let stack[top] = high
endif
wait
loop top >= 0
print newline, "sorted: ",
for i = 0 to size - 1
print list[i],
gosub printcomma
next i
return
sub printcomma
if i < size - 1 then
print comma, " ",
endif
return

36
Task/Babbage-problem/COBOL/babbage-problem.cobol
View file

@ -1,28 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. BABBAGE-PROGRAM.
IDENTIFICATION DIVISION.
PROGRAM-ID. BABBAGE-PROGRAM.
* A line beginning with an asterisk is an explanatory note.
* The machine will disregard any such line.
DATA DIVISION.
WORKING-STORAGE SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
* In this part of the program we reserve the storage space we shall
* be using for our variables, using a 'PICTURE' clause to specify
* how many digits the machine is to keep free.
* The prefixed number 77 indicates that these variables do not form part
* of any larger 'record' that we might want to deal with as a whole.
77 N PICTURE 99999.
77 N PICTURE 99999.
* We know that 99,736 is a valid answer.
77 N-SQUARED PICTURE 9999999999.
77 LAST-SIX PICTURE 999999.
PROCEDURE DIVISION.
77 N-SQUARED PICTURE 9999999999.
77 LAST-SIX PICTURE 999999.
PROCEDURE DIVISION.
* Here we specify the calculations that the machine is to carry out.
CONTROL-PARAGRAPH.
PERFORM COMPUTATION-PARAGRAPH VARYING N FROM 1 BY 1
UNTIL LAST-SIX IS EQUAL TO 269696.
STOP RUN.
COMPUTATION-PARAGRAPH.
MULTIPLY N BY N GIVING N-SQUARED.
MOVE N-SQUARED TO LAST-SIX.
CONTROL-PARAGRAPH.
PERFORM COMPUTATION-PARAGRAPH VARYING N FROM 1 BY 1
UNTIL LAST-SIX IS EQUAL TO 269696.
STOP RUN.
COMPUTATION-PARAGRAPH.
MULTIPLY N BY N GIVING N-SQUARED.
MOVE N-SQUARED TO LAST-SIX.
* Since the variable LAST-SIX can hold a maximum of six digits,
* only the final six digits of N-SQUARED will be moved into it:
* the rest will not fit and will simply be discarded.
IF LAST-SIX IS EQUAL TO 269696 THEN DISPLAY N.
IF LAST-SIX IS EQUAL TO 269696 THEN DISPLAY N.
END PROGRAM BABBAGE-PROGRAM.

38
Task/Balanced-brackets/Factor/balanced-brackets-1.factor
View file

@ -1,22 +1,20 @@
USING: io formatting locals kernel math sequences unicode.case ;
IN: balanced-brackets
USING: combinators formatting kernel math random sequences strings ;
IN: rosetta-code.balanced-brackets
:: balanced ( str -- )
0 :> counter!
1 :> ok!
str
[ dup length 0 > ]
[ 1 cut swap
"[" = [ counter 1 + counter! ] [ counter 1 - counter! ] if
counter 0 < [ 0 ok! ] when
]
while
drop
ok 0 =
[ "NO" ]
[ counter 0 > [ "NO" ] [ "YES" ] if ]
if
print ;
: balanced? ( str -- ? )
0 swap [
{
{ CHAR: [ [ 1 + t ] }
{ CHAR: ] [ 1 - dup 0 >= ] }
[ drop t ]
} case
] all? swap zero? and ;
readln
balanced
: bracket-pairs ( n -- str )
[ "[]" ] replicate "" concat-as ;
: balanced-brackets-main ( -- )
5 bracket-pairs randomize dup balanced? "" "not " ?
"String \"%s\" is %sbalanced.\n" printf ;
MAIN: balanced-brackets-main

34
Task/Balanced-brackets/Factor/balanced-brackets-2.factor
View file

@ -1,20 +1,22 @@
USING: io formatting locals kernel math sequences unicode.case ;
IN: balanced-brackets
: map-braces ( -- qout )
[
{
{ "[" [ drop 1 ] }
{ "]" [ drop -1 ] }
[ drop 0 ]
} case
]
;
:: balanced ( str -- )
0 :> counter!
1 :> ok!
str
[ dup length 0 > ]
[ 1 cut swap
"[" = [ counter 1 + counter! ] [ counter 1 - counter! ] if
counter 0 < [ 0 ok! ] when
]
while
drop
ok 0 =
[ "NO" ]
[ counter 0 > [ "NO" ] [ "YES" ] if ]
if
print ;
: balanced? ( str -- ? )
map-braces map sum 0 =
;
"[1+2*[3+4*[5+6]-3]*4-[3*[3+3]]]" balanced?
-- Data stack:
t
readln
balanced

86
Task/Balanced-ternary/Koka/balanced-ternary.koka Normal file
View file

@ -0,0 +1,86 @@
type btdigit
Pos
Zero
Neg
alias btern = list<btdigit>
fun to_string(n: btern): string
join(
n.reverse.map fn(d)
match d
Pos -> "+"
Zero -> "0"
Neg -> "-"
)
fun from_string(s: string): exn btern
var sl := Nil
s.foreach fn(c)
match c
'+' -> sl := Cons(Pos, sl)
'0' -> sl := Cons(Zero, sl)
'-' -> sl := Cons(Neg, sl)
_ -> throw("Invalid Character")
sl
fun to_int(n: btern): int
match n
Nil -> 0
Cons(Zero, Nil) -> 0
Cons(Pos, rst) -> 1+3*rst.to_int
Cons(Neg, rst) -> -1+3*rst.to_int
Cons(Zero, rst) -> 3*rst.to_int
fun from_int(n: int): <exn> btern
if n == 0 then [] else
match n % 3
0 -> Cons(Zero, from_int((n/3).unsafe-decreasing))
1 -> Cons(Pos, from_int(((n - 1)/3).unsafe-decreasing))
2 -> Cons(Neg, from_int(((n+1)/3).unsafe-decreasing))
_ -> throw("Impossible")
fun (+)(n1: btern, n2: btern): <exn,div> btern
match (n1, n2)
([], a) -> a
(a, []) -> a
(Cons(Pos, t1), Cons(Neg, t2)) ->
val sum = t1 + t2
if sum.is-nil then [] else Cons(Zero, sum)
(Cons(Neg, t1), Cons(Pos, t2)) ->
val sum = t1 + t2
if sum.is-nil then [] else Cons(Zero, sum)
(Cons(Zero, t1), Cons(Zero, t2)) ->
val sum = t1 + t2
if sum.is-nil then [] else Cons(Zero, sum)
(Cons(Pos, t1), Cons(Pos, t2)) -> Cons(Neg, t1 + t2 + [Pos])
(Cons(Neg, t1), Cons(Neg, t2)) -> Cons(Pos, t1 + t2 + [Neg])
(Cons(Zero, t1), Cons(h, t2)) -> Cons(h, t1 + t2)
(Cons(h, t1), Cons(Zero, t2)) -> Cons(h, t1 + t2)
_ -> throw("Impossible")
fun neg(n: btern)
n.map fn(d)
match d
Pos -> Neg
Zero -> Zero
Neg -> Pos
fun (-)(n1: btern, n2: btern): <exn,div> btern
n1 + neg(n2)
fun (*)(n1, n2)
match n2
[] -> []
[Pos] -> n1
[Neg] -> n1.neg
(Cons(Pos, t)) -> Cons(Zero, t*n1) + n1
(Cons(Neg, t)) -> Cons(Zero, t*n1) - n1
(Cons(Zero, t)) -> Cons(Zero, t*n1)
fun main()
val a = "+-0++0+".from_string
val b = (-436).from_int
val c = "+-++-".from_string
val d = a * (b - c)
println("a = " ++ a.to_int.show ++ "\nb = " ++ b.to_string ++ "\nc = " ++ c.to_int.show ++ "\na * (b - c) = " ++ d.to_string ++ " = " ++ d.to_int.show )

4
Task/Barnsley-fern/Nim/barnsley-fern.nim
View file

@ -1,4 +1,4 @@
import nimPNG, random
import nimPNG, std/random
randomize()
@ -46,7 +46,7 @@ proc drawPixel(x,y:float) =
var x, y: float = 0.0
for i in 1..iterations:
var r = random(101)
var r = rand(101)
var nx, ny: float
if r <= 85:
nx = 0.85 * x + 0.04 * y

15
Task/Bell-numbers/Maxima/bell-numbers.maxima Normal file
View file

@ -0,0 +1,15 @@
/* Subfactorial numbers */
subfactorial(n):=block(
subf[0]:1,
subf[n]:n*subf[n-1]+(-1)^n,
subf[n])$
/* Bell numbers implementation */
my_bell(n):=if n=0 then 1 else block(
makelist((1/((n-1)!))*subfactorial(j)*binomial(n-1,j)*(n-j)^(n-1),j,0,n-1),
apply("+",%%))$
/* First 50 */
block(
makelist(my_bell(u),u,0,49),
table_form(%%));

3
Task/Bernoulli-numbers/Maxima/bernoulli-numbers.maxima Normal file
View file

@ -0,0 +1,3 @@
block(makelist([sconcat("B","(",i,")","="),bern(i)],i,0,60),
sublist(%%,lambda([x],x[2]#0)),
table_form(%%))

65
Task/Bifid-cipher/Ruby/bifid-cipher.rb Normal file
View file

@ -0,0 +1,65 @@
def cleanMsg(msg, square)
msg.upcase!
msg.delete!(' ')
msg.delete!('J') if square.index('J') == nil
end
def encrypt(msg, square)
cleanMsg msg, square
sq_size = (square.length ** 0.5).to_i
rows = [0] * msg.length
cols = [0] * msg.length
(0...msg.length).each do |i|
p = square.index(msg[i])
rows[i], cols[i] = p / sq_size, p % sq_size
end
result = ""
rows.concat(cols).each_slice(2) do |coord|
result += square[coord[0]*sq_size + coord[1]]
end
return result
end
def decrypt(msg, square)
msg.upcase!; square.upcase!
sq_size = (square.length ** 0.5).to_i
coords = []
result = ""
(0...msg.length).each do |i|
p = square.index(msg[i])
coords << p / sq_size
coords << p % sq_size
end
for i in (0...coords.length/2) do
row, col = coords[i], coords[i+coords.length/2]
result += square[row*sq_size + col]
end
return result
end
def printSquare(square)
sq_size = (square.length ** 0.5).to_i
(0..square.length).step(sq_size).each do |i|
print square[i...(i+sq_size)], "\n"
end
end
tests = [["ATTACKATDAWN" , "ABCDEFGHIKLMNOPQRSTUVWXYZ"],
["FLEEATONCE" , "BGWKZQPNDSIOAXEFCLUMTHYVR"],
["ATTACKATDAWN" , "ABCDEFGHIKLMNOPQRSTUVWXYZ"],
["the invasion will start on the first of january", "BGWKZQPNDSIOAXEFCLUMTHYVR"],
["THIS MESSAGE HAS NUMBERS 2023", "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"],
]
for test in tests
message = test[0]; square = test[1];
encrypted = encrypt(message, square)
decrypted = decrypt(encrypted, square)
puts "using the polybius:"
printSquare(square)
puts "the plain message:", message
puts "encrypted:", encrypted
puts "decrypted:", decrypted
puts "===================================================="
end

5
Task/Binary-digits/Dt/binary-digits.dt Normal file
View file

@ -0,0 +1,5 @@
[dup 1 gt? [dup 2 % swap 2 / loop] swap do?] \loop def
[\loop doin rev \to-string map "" join] \bin def
[0 1 2 5 50 9000] \bin map " " join pl

239
Task/Bioinformatics-base-count/AArch64-Assembly/bioinformatics-base-count.aarch64 Normal file
View file

@ -0,0 +1,239 @@
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program cptAdn64.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ LIMIT, 30
.equ SHIFT, 8
//.include "../../ficmacros64.inc" // use for debugging
/************************************/
/* Initialized data */
/************************************/
.data
szMessResult: .asciz "Result: "
szDNA1: .ascii "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG"
.ascii "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG"
.ascii "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT"
.ascii "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT"
.ascii "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG"
.ascii "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA"
.ascii "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT"
.ascii "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG"
.ascii "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC"
.asciz "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"
szCarriageReturn: .asciz "\n"
szMessStart: .asciz "Program 64 bits start.\n"
szMessCounterA: .asciz "Base A : "
szMessCounterC: .asciz "Base C : "
szMessCounterG: .asciz "Base G : "
szMessCounterT: .asciz "Base T : "
szMessTotal: .asciz "Total : "
sPrintLine: .fill LIMIT + SHIFT + 2,1,' ' // init line with spaces
/************************************/
/* UnInitialized data */
/************************************/
.bss
sZoneConv: .skip 24
/************************************/
/* code section */
/************************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessStart
bl affichageMess
ldr x0,qAdrszDNA1
bl printDNA
ldr x0,qAdrszDNA1
bl countBase
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc 0 // perform the system call
qAdrszDNA1: .quad szDNA1
qAdrsZoneConv: .quad sZoneConv
qAdrszMessResult: .quad szMessResult
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszMessStart: .quad szMessStart
/***************************************************/
/* count dna line and print */
/***************************************************/
/* x0 contains dna string address */
printDNA:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
stp x8,x9,[sp,-16]!
mov x8,x0 // save address
mov x4,#0 // counter
mov x3,#0 // index string
mov x4,#0 // byte line counter
mov x5,#1 // start line value
ldr x7,qAdrsPrintLine
ldr x9,qAdrsZoneConv
1:
ldrb w6,[x8,x3] // load byte of dna
cmp x6,#0 // end string ?
beq 4f // yes -> end
add x1,x7,#SHIFT
strb w6,[x1,x4] // store byte in display line
add x4,x4,#1 // increment index line
cmp x4,#LIMIT // end line ?
blt 3f
mov x0,x5 // convert decimal counter base
mov x1,x9
bl conversion10
mov x2,xzr
2: // copy decimal conversion in display line
ldrb w6,[x9,x2]
strb w6,[x7,x2]
add x2,x2,1
cmp x2,x0
blt 2b
mov x0,#0 // Zero final
add x1,x7,#LIMIT
add x1,x1,#SHIFT + 1
strb w0,[x1]
mov x0,x7 // line display
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
add x5,x5,#LIMIT // add line size to counter
mov x4,#0 // and init line index
3:
add x3,x3,#1 // increment index string
b 1b // and loop
4: // display end line if line contains base
cmp x4,#0
beq 100f
mov x0,x5
mov x1,x9
bl conversion10
mov x2,xzr
5: // copy decimal conversion in display line
ldrb w6,[x9,x2]
strb w6,[x7,x2]
add x2,x2,1
cmp x2,x0
blt 5b
mov x0,#0 // Zero final
add x1,x7,x4
add x1,x1,#SHIFT
strb w0,[x1]
mov x0,x7 // last line display
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
100:
ldp x8,x9,[sp],16
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
qAdrsPrintLine: .quad sPrintLine
/***************************************************/
/* count bases */
/***************************************************/
/* x0 contains dna string address */
countBase:
stp x1,lr,[sp,-16]!
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
mov x2,#0 // string index
mov x3,#0 // A counter
mov x4,#0 // C counter
mov x5,#0 // G counter
mov x6,#0 // T counter
1:
ldrb w1,[x0,x2] // load byte of dna
cmp x1,#0 // end string ?
beq 2f
cmp x1,#'A'
cinc x3,x3,eq
cmp x1,#'C'
cinc x4,x4,eq
cmp x1,#'G'
cinc x5,x5,eq
cmp x1,#'T'
cinc x6,x6,eq
add x2,x2,#1
b 1b
2:
mov x0,x3 // convert decimal counter A
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrszMessCounterA
bl affichageMess
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x4 // convert decimal counter C
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrszMessCounterC
bl affichageMess
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x5 // convert decimal counter G
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrszMessCounterG
bl affichageMess
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x6 // convert decimal counter T
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrszMessCounterT
bl affichageMess
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
add x0,x3,x4 // convert decimal total
add x0,x0,x5
add x0,x0,x6
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrszMessTotal
bl affichageMess
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
100:
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16 // TODO: retaur à completer
ret
qAdrszMessCounterA: .quad szMessCounterA
qAdrszMessCounterC: .quad szMessCounterC
qAdrszMessCounterG: .quad szMessCounterG
qAdrszMessCounterT: .quad szMessCounterT
qAdrszMessTotal: .quad szMessTotal
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeARM64.inc"

205
Task/Bioinformatics-base-count/ARM-Assembly/bioinformatics-base-count.arm Normal file
View file

@ -0,0 +1,205 @@
/* ARM assembly Raspberry PI */
/* program cptAdn.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../constantes.inc"
.equ LIMIT, 50
.equ SHIFT, 11
/************************************/
/* Initialized data */
/************************************/
.data
szMessResult: .asciz "Result: "
szDNA1: .ascii "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG"
.ascii "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG"
.ascii "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT"
.ascii "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT"
.ascii "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG"
.ascii "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA"
.ascii "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT"
.ascii "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG"
.ascii "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC"
.asciz "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"
szCarriageReturn: .asciz "\n"
szMessStart: .asciz "Program 32 bits start.\n"
szMessCounterA: .asciz "Base A : "
szMessCounterC: .asciz "Base C : "
szMessCounterG: .asciz "Base G : "
szMessCounterT: .asciz "Base T : "
szMessTotal: .asciz "Total : "
/************************************/
/* UnInitialized data */
/************************************/
.bss
sZoneConv: .skip 24
sPrintLine: .skip LIMIT + SHIFT + 2
/************************************/
/* code section */
/************************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessStart
bl affichageMess
ldr r0,iAdrszDNA1
bl printDNA
ldr r0,iAdrszDNA1
bl countBase
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc 0 @ perform the system call
iAdrszDNA1: .int szDNA1
iAdrsZoneConv: .int sZoneConv
iAdrszMessResult: .int szMessResult
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszMessStart: .int szMessStart
/***************************************************/
/* count dna line and print */
/***************************************************/
/* r0 contains dna string address */
printDNA:
push {r1-r8,lr} @ save registers
mov r8,r0 @ save address
mov r4,#0 @ counter
mov r3,#0 @ index stone
mov r4,#0
mov r5,#1
ldr r7,iAdrsPrintLine
1:
ldrb r6,[r8,r3] @ load byte of dna
cmp r6,#0 @ end string ?
beq 4f
add r1,r7,#SHIFT
strb r6,[r1,r4] @ store byte in display line
add r4,r4,#1 @ increment index line
cmp r4,#LIMIT @ end line ?
blt 3f
mov r0,r5 @ convert decimal counter base
mov r1,r7
bl conversion10
mov r0,#0 @ Zero final
add r1,r7,#LIMIT
add r1,r1,#SHIFT + 1
strb r0,[r1]
mov r0,r7 @ line display
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
add r5,r5,#LIMIT @ add line size to counter
mov r4,#0 @ and init line index
3:
add r3,r3,#1 @ increment index string
b 1b @ and loop
4: @ display end line if line contains base
cmp r4,#0
beq 100f
mov r0,r5
mov r1,r7
bl conversion10
mov r0,#0 @ Zero final
add r1,r7,r4
add r1,r1,#SHIFT
strb r0,[r1]
mov r0,r7 @ last line display
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
100:
pop {r1-r8,pc}
iAdrsPrintLine: .int sPrintLine
/***************************************************/
/* count bases */
/***************************************************/
/* r0 contains dna string address */
countBase:
push {r1-r6,lr} @ save registers
mov r2,#0 @ string index
mov r3,#0 @ A counter
mov r4,#0 @ C counter
mov r5,#0 @ G counter
mov r6,#0 @ T counter
1:
ldrb r1,[r0,r2] @ load byte of dna
cmp r1,#0 @ end string ?
beq 2f
cmp r1,#'A'
addeq r3,r3,#1
cmp r1,#'C'
addeq r4,r4,#1
cmp r1,#'G'
addeq r5,r5,#1
cmp r1,#'T'
addeq r6,r6,#1
add r2,r2,#1
b 1b
2:
mov r0,r3 @ convert decimal counter A
ldr r1,iAdrsZoneConv
bl conversion10
ldr r0,iAdrszMessCounterA
bl affichageMess
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r4 @ convert decimal counter C
ldr r1,iAdrsZoneConv
bl conversion10
ldr r0,iAdrszMessCounterC
bl affichageMess
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r5 @ convert decimal counter G
ldr r1,iAdrsZoneConv
bl conversion10
ldr r0,iAdrszMessCounterG
bl affichageMess
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r6 @ convert decimal counter T
ldr r1,iAdrsZoneConv
bl conversion10
ldr r0,iAdrszMessCounterT
bl affichageMess
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
add r0,r3,r4 @ convert decimal total
add r0,r0,r5
add r0,r0,r6
ldr r1,iAdrsZoneConv
bl conversion10
ldr r0,iAdrszMessTotal
bl affichageMess
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
100:
pop {r1-r6,pc}
iAdrszMessCounterA: .int szMessCounterA
iAdrszMessCounterC: .int szMessCounterC
iAdrszMessCounterG: .int szMessCounterG
iAdrszMessCounterT: .int szMessCounterT
iAdrszMessTotal: .int szMessTotal
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../affichage.inc"

34
Task/Bitmap-Bresenhams-line-algorithm/Ksh/bitmap-bresenhams-line-algorithm.ksh Normal file
View file

@ -0,0 +1,34 @@
function line {
typeset x0=$1 y0=$2 x1=$3 y1=$4
if ((x0 > x1))
then
((dx = x0 - x1)); ((sx = -1))
else
((dx = x1 - x0)); ((sx = 1))
fi
if ((y0 > y1))
then
((dy = y0 - y1)); ((sy = -1))
else
((dy = y1 - y0)); ((sy = 1))
fi
if ((dx > dy))
then
((err = dx))
else
((err = -dy))
fi
((err /= 2)); ((e2 = 0))
while :
do
echo $x0 $y0
((x0 == x1 && y0 == y1)) && return
((e2 = err))
((e2 > -dx)) && { ((err -= dy)); ((x0 += sx)) }
((e2 < dy)) && { ((err += dx)); ((y0 += sy)) }
done
}

42
Task/Bitmap-Midpoint-circle-algorithm/Evaldraw/bitmap-midpoint-circle-algorithm.evaldraw Normal file
View file

@ -0,0 +1,42 @@
()
{
cls(0);
setcol(0xffffff);
srand(1234);
for(i=0; i<1000; i++) {
rad = int( abs(nrnd*10) );
x=rnd*xres;
y=rnd*yres;
drawcircle(x,y,rad);
//drawsph(x,y,-rad);
}
}
drawcircle(cx,cy,r) {
if (cx+r < 0 || cy+r < 0) return;
if (cx-r > xres || cy-r > yres) return;
r = int(r);
if (r<=0) return;
r2 = r+r;
x = r; y = 0;
dy = -2; dx = r2+r2 - 4;
d = r2-1;
while(y<=x) {
setpix(cx-x, cy-y);
setpix(cx+x, cy-y);
setpix(cx-x, cy+y);
setpix(cx+x, cy+y);
setpix(cx-y, cy-x);
setpix(cx+y, cy-x);
setpix(cx-y, cy+x);
setpix(cx+y, cy+x);
d += dy;
dy -= 4;
++y;
if (d<0) {
d += dx;
dx -= 4;
--x;
}
}
}

32
Task/Bitwise-operations/COBOL/bitwise-operations-1.cobol
View file

@ -5,10 +5,9 @@
LOCAL-STORAGE SECTION.
01 a PIC 1(32) USAGE BIT.
01 b PIC 1(32) USAGE BIT.
01 result PIC 1(32) USAGE BIT.
01 result-disp REDEFINES result PIC S9(9) COMP.
01 result-disp REDEFINES result
PIC S9(9) USAGE COMPUTATIONAL.
LINKAGE SECTION.
01 a-int USAGE BINARY-LONG.
01 b-int USAGE BINARY-LONG.
@ -29,7 +28,28 @@
COMPUTE result = a B-XOR b
DISPLAY "a exclusive-or b is " result-disp
*> COBOL does not have shift or rotation operators.
*> More complex operations can be constructed from these.
GOBACK
.
COMPUTE result = B-NOT (a B-XOR b)
DISPLAY "Logical equivalence of a and b is " result-disp
COMPUTE result = (B-NOT a) B-AND b
DISPLAY "Logical implication of a and b is " result-disp
*> Shift and rotation operators were only added in COBOL 2023.
COMPUTE result = a B-SHIFT-L b
DISPLAY "a shifted left by b is " result-disp
COMPUTE result = b B-SHIFT-R a
DISPLAY "b shifted right by a is " result-disp
COMPUTE result = a B-SHIFT-LC b
DISPLAY "a rotated left by b is " result-disp
COMPUTE result = b B-SHIFT-RC a
DISPLAY "b rotated right by a is " result-disp
GOBACK.
END PROGRAM bitwise-ops.

6
Task/Bitwise-operations/COBOL/bitwise-operations-2.cobol
View file

@ -4,7 +4,6 @@
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 result USAGE BINARY-LONG.
78 arg-len VALUE LENGTH OF result.
LINKAGE SECTION.
@ -37,5 +36,6 @@
CALL "CBL_IMP" USING a, result, VALUE arg-len
DISPLAY "Logical implication of a and b is " result
GOBACK
.
GOBACK.
END PROGRAM mf-bitwise-ops.

8
Task/Bitwise-operations/Elena/bitwise-operations.elena
View file

@ -4,10 +4,10 @@ extension testOp
{
bitwiseTest(y)
{
console.printLine(self," and ",y," = ",self.and(y));
console.printLine(self," or ",y," = ",self.or(y));
console.printLine(self," xor ",y," = ",self.xor(y));
console.printLine("not ",self," = ",self.Inverted);
console.printLine(self," and ",y," = ",self & y);
console.printLine(self," or ",y," = ",self | y);
console.printLine(self," xor ",y," = ",self ^ y);
console.printLine("not ",self," = ",self.BInverted);
console.printLine(self," shr ",y," = ",self.shiftRight(y));
console.printLine(self," shl ",y," = ",self.shiftLeft(y));
}

112
Task/Brazilian-numbers/ANSI-BASIC/brazilian-numbers.basic Normal file
View file

@ -0,0 +1,112 @@
1000 REM Brazilian numbers
1010 DECLARE EXTERNAL FUNCTION IsBrazilian
1020 DECLARE EXTERNAL FUNCTION SameDigits
1030 DECLARE EXTERNAL FUNCTION IsPrime
1040 PRINT "First 20 Brazilian numbers:"
1050 LET C = 0
1060 LET N = 7
1070 DO WHILE C < 20
1080 IF IsBrazilian(N) <> 0 THEN
1090 PRINT N;
1100 LET C = C + 1
1110 END IF
1120 LET N = N + 1
1130 LOOP
1140 PRINT
1150 PRINT
1160 PRINT "First 20 odd Brazilian numbers:"
1170 LET C = 0
1180 LET N = 7
1190 DO WHILE C < 20
1200 IF IsBrazilian(N) <> 0 THEN
1210 PRINT N;
1220 LET C = C + 1
1230 END IF
1240 LET N = N + 2
1250 LOOP
1260 PRINT
1270 PRINT
1280 PRINT "First 20 prime Brazilian numbers:"
1290 LET C = 0
1300 LET N = 7
1310 DO WHILE C < 20
1320 IF IsBrazilian(N) <> 0 THEN
1330 PRINT N;
1340 LET C = C + 1
1350 END IF
1360 DO
1370 LET N = N + 2
1380 LOOP WHILE IsPrime(N) = 0
1390 LOOP
1400 PRINT
1410 END
1420 REM
1430 EXTERNAL FUNCTION IsBrazilian(N)
1440 REM Result: 1 if N is Brazilian, 0 otherwise
1450 IF N < 7 THEN
1460 LET IsBrazilian = 0
1470 ELSEIF (MOD(N, 2) = 0) AND (N >= 8) THEN
1480 LET IsBrazilian = 1
1490 ELSE
1500 FOR B = 2 TO N - 2
1510 IF SameDigits(N, B) <> 0 THEN
1520 LET IsBrazilian = 1
1530 EXIT FUNCTION
1540 END IF
1550 NEXT B
1560 LET IsBrazilian = 0
1570 END IF
1580 END FUNCTION
1590 REM
1600 EXTERNAL FUNCTION SameDigits(N, B)
1610 REM Result: 1 if N has same digits in the base B, 0 otherwise
1620 LET NL = N ! Local N
1630 LET F = MOD(NL, B)
1640 LET NL = INT(NL / B)
1650 DO WHILE NL > 0
1660 IF MOD(NL, B) <> F THEN
1670 LET SameDigits = 0
1680 EXIT FUNCTION
1690 END IF
1700 LET NL = INT(NL / B)
1710 LOOP
1720 LET SameDigits = 1
1730 END FUNCTION
1740 REM
1750 EXTERNAL FUNCTION IsPrime(N)
1760 REM Result: non-zero if N is prime, 0 otherwise
1770 IF N < 2 THEN
1780 LET IsPrime = 0
1790 ELSEIF MOD(N, 2) = 0 THEN
1800 REM IsPrime = (N = 2)
1810 IF N = 2 THEN
1820 LET IsPrime = 1
1830 ELSE
1840 LET IsPrime = 0
1850 END IF
1860 ELSEIF MOD(N, 3) = 0 THEN
1870 REM IsPrime = (N = 3)
1880 IF N = 3 THEN
1890 LET IsPrime = 1
1900 ELSE
1910 LET IsPrime = 0
1920 END IF
1930 ELSE
1940 LET D = 5
1950 DO WHILE D * D <= N
1960 IF MOD(N, D) = 0 THEN
1970 LET IsPrime = 0
1980 EXIT FUNCTION
1990 ELSE
2000 LET D = D + 2
2010 IF MOD(N, D) = 0 THEN
2020 LET IsPrime = 0
2030 EXIT FUNCTION
2040 ELSE
2050 LET D = D + 4
2060 END IF
2070 END IF
2080 LOOP
2090 LET IsPrime = 1
2100 END IF
2110 END FUNCTION

111
Task/Brazilian-numbers/Modula-2/brazilian-numbers.mod2 Normal file
View file

@ -0,0 +1,111 @@
MODULE BrazilianNumbers;
FROM STextIO IMPORT
WriteLn, WriteString;
FROM SWholeIO IMPORT
WriteInt;
VAR
C, N: CARDINAL;
PROCEDURE SameDigits(N, B: CARDINAL): BOOLEAN;
VAR
F: CARDINAL;
BEGIN
F := N MOD B;
N := N / B;
WHILE N > 0 DO
IF N MOD B <> F THEN
RETURN FALSE;
END;
N := N / B;
END;
RETURN TRUE;
END SameDigits;
PROCEDURE IsBrazilian(N: CARDINAL): BOOLEAN;
VAR
B: CARDINAL;
BEGIN
IF N < 7 THEN
RETURN FALSE
ELSIF (N MOD 2 = 0) AND (N >= 8) THEN
RETURN TRUE
ELSE
FOR B := 2 TO N - 2 DO
IF SameDigits(N, B) THEN
RETURN TRUE
END
END;
RETURN FALSE;
END
END IsBrazilian;
PROCEDURE IsPrime(N: CARDINAL): BOOLEAN;
VAR
D: CARDINAL;
BEGIN
IF N < 2 THEN
RETURN FALSE;
ELSIF N MOD 2 = 0 THEN
RETURN N = 2;
ELSIF N MOD 3 = 0 THEN
RETURN N = 3;
ELSE
D := 5;
WHILE D * D <= N DO
IF N MOD D = 0 THEN
RETURN FALSE
ELSE
D := D + 2;
IF N MOD D = 0 THEN
RETURN FALSE
ELSE
D := D + 4
END
END
END;
RETURN TRUE;
END
END IsPrime;
BEGIN
WriteString("First 20 Brazilian numbers:");
WriteLn;
C := 0; N := 7;
WHILE C < 20 DO
IF IsBrazilian(N) THEN
WriteInt(N, 1);
WriteString(" ");
C := C + 1;
END;
N := N + 1;
END;
WriteLn; WriteLn;
WriteString("First 20 odd Brazilian numbers:");
WriteLn;
C := 0; N := 7;
WHILE C < 20 DO
IF IsBrazilian(N) THEN
WriteInt(N, 1);
WriteString(" ");
C := C + 1;
END;
N := N + 2;
END;
WriteLn; WriteLn;
WriteString("First 20 prime Brazilian numbers:");
WriteLn;
C := 0; N := 7;
WHILE C < 20 DO
IF IsBrazilian(N) THEN
WriteInt(N, 1);
WriteString(" ");
C := C + 1;
END;
REPEAT
N := N + 2
UNTIL IsPrime(N);
END;
WriteLn;
END BrazilianNumbers.

62
Task/Brazilian-numbers/Nascom-BASIC/brazilian-numbers.basic Normal file
View file

@ -0,0 +1,62 @@
10 REM Brazilian numbers
20 PRINT "First 20 Brazilian numbers:"
30 C=0:N=7
40 IF C>=20 THEN 90
50 GOSUB 320
60 IF BR THEN PRINT N;:C=C+1
70 N=N+1
80 GOTO 40
90 PRINT:PRINT
100 PRINT "First 20 odd Brazilian numbers:"
110 C=0:N=7
120 IF C>=20 THEN 170
130 GOSUB 320
140 IF BR THEN PRINT N;:C=C+1
150 N=N+2
160 GOTO 120
170 PRINT:PRINT
180 PRINT "First 12 prime Brazilian numbers:"
190 C=0:N=7
200 IF C>=12 THEN 270
210 GOSUB 320
220 IF BR THEN PRINT N;:C=C+1
230 N=N+2
240 GOSUB 530
250 IF NOT PRM THEN 230
260 GOTO 200
270 PRINT
280 END
290 REM ** Is Brazilian?
300 REM Result: BR=-1 if N is Brazilian
310 REM 0 otherwise
320 IF N<7 THEN BR=0:RETURN
330 IF INT(N/2)*2=N AND N>=8 THEN BR=-1:RETURN
340 FOR B=2 TO N-2
350 GOSUB 430
360 IF SMD THEN BR=-1:RETURN
370 NEXT B
380 BR=0
390 RETURN
400 REM ** Same digits?
410 REM Result: SMD=-1 if N has same digits in B,
420 REM 0 otherwise
430 NL=N:REM "Local" N
440 NDB=INT(NL/B)
450 F=NL-NDB*B
460 NL=NDB:NDB=INT(NL/B)
470 IF NL<=0 THEN SMD=-1:RETURN
480 IF NL-NDB*B<>F THEN SMD=0:RETURN
490 NL=INT(NL/B):NDB=INT(NL/B)
500 GOTO 470
510 REM ** Is prime?
520 REM Result: PRM=-1 if N prime, 0 otherwise
530 IF N<2 THEN PRM=0:RETURN
540 IF INT(N/2)*2=N THEN PRM=N=2:RETURN
550 IF INT(N/3)*3=N THEN PRM=N=3:RETURN
560 D=5
570 IF D*D>N THEN PRM=-1:RETURN
580 IF INT(N/D)*D=N THEN PRM=0:RETURN
590 D=D+2
600 IF INT(N/D)*D=N THEN PRM=0:RETURN
610 D=D+4
620 GOTO 570

2
Task/Brazilian-numbers/Scala/brazilian-numbers-2.scala
View file

@ -31,6 +31,6 @@ object Brazilian extends App {
println(s"$listStr: " + stream.filter(isBrazilian(_)).take(limit).toList)
println("be a little patient, it will take some time")
val bigElement = LazyList.from(7).filter(isBrazilian(_)).drop(bigLimit - 1).take(1).head
val bigElement = LazyList.from(7).filter(isBrazilian(_)).drop(bigLimit - 1).head
println(s"brazilian($bigLimit): $bigElement")
}

46
Task/Brilliant-numbers/FreeBASIC/brilliant-numbers.basic Normal file
View file

@ -0,0 +1,46 @@
function is_prime( n as uinteger ) as boolean
if n = 2 then return true
if n<2 or n mod 2 = 0 then return false
for i as uinteger = 3 to sqr(n) step 2
if (n mod i) = 0 then return false
next i
return true
end function
function first_prime_factor( n as uinteger ) as uinteger
if n mod 2 = 0 then return 2
for i as uinteger = 3 to sqr(n) step 2
if (n mod i) = 0 then return i
next i
return n
end function
dim as uinteger count = 0, n = 0, ff, sf, expo = 0
while count<100
ff = first_prime_factor(n)
sf = n/ff
if is_prime(sf) and len(str(ff)) = len(str(sf)) then
print n,
count = count + 1
if count mod 6 = 0 then print
end if
n = n + 1
wend
print
count = 0
n = 0
do
ff = first_prime_factor(n)
sf = n/ff
if is_prime(sf) and len(str(ff)) = len(str(sf)) then
count = count + 1
if n > 10^expo then
print n;" is brilliant #"; count
expo = expo + 1
if expo = 9 then end
end if
end if
n = n + 1
loop

2
Task/Brilliant-numbers/Scala/brilliant-numbers.scala
View file

@ -28,7 +28,7 @@ def brilliantSemiPrimes(limit: Int): Seq[Int] = {
val (bril, index) = brilliantSemiPrimes((limit * 1.25).toInt)
.zipWithIndex
.dropWhile((b, _i) => b < limit)
.take(1).head
.head
val duration = System.currentTimeMillis - start
println(f"first >= $limit%7d is $bril%7d at position ${index+1}%5d [time(ms) $duration%2d]")
}

62
Task/Brownian-tree/Evaldraw/brownian-tree.evaldraw Normal file
View file

@ -0,0 +1,62 @@
enum{SIZE=256, PARTICLES_PER_FRAME=10, PARTICLE_OK, GIVE_UP};
static world[SIZE][SIZE];
()
{
// set the seed
if (numframes==0) world[SIZE/2][SIZE/2] = 1;
t = klock();
simulate_brownian_tree(t);
cls(0);
for (y = 0; y < SIZE; y++){
for (x = 0; x < SIZE; x++){
cell = world[y][x];
if ( cell ) {
s = 100; // color scale
setcol(128+(s*cell % 128), 128+(s*.7*cell % 128), 128+(s*.1*cell % 128) );
setpix(x,y);
}
}
}
moveto(0,SIZE+15);
setcol(0xffffff);
printf("%g frames", numframes);
}
plop_particle(&px, &py) {
for (try=0; try<1000; try++) {
px = int(rnd*SIZE);
py = int(rnd*SIZE);
if (world[py][px] == 0) return PARTICLE_OK;
}
return GIVE_UP;
}
simulate_brownian_tree(time){
for(iter=0; iter<PARTICLES_PER_FRAME; iter++) // Rate of particle creation
{
// set particle's initial position
px=0; py=0;
if ( plop_particle(px,py) == GIVE_UP ) return;
while (1) { // Keep iterating until we bump into a solid particle
// randomly choose a direction
dx = int(rnd * 3) - 1;
dy = int(rnd * 3) - 1;
if (dx + px < 0 || dx + px >= SIZE || dy + py < 0 || dy + py >= SIZE)
{
// Restart if outside of screen
if ( plop_particle(px,py) == GIVE_UP ) return;
}else if (world[py + dy][px + dx]){
// bumped into something
world[py][px] = time;
break;
}else{
py += dy;
px += dx;
}
}
}
}

48
Task/Brownian-tree/Factor/brownian-tree.factor
View file

@ -1,48 +0,0 @@
USING: accessors images images.loader kernel literals math
math.vectors random sets ;
FROM: sets => in? ;
EXCLUDE: sequences => move ;
IN: rosetta-code.brownian-tree
CONSTANT: size 512
CONSTANT: num-particles 30000
CONSTANT: seed { 256 256 }
CONSTANT: spawns { { 10 10 } { 502 10 } { 10 502 } { 502 502 } }
CONSTANT: bg-color B{ 0 0 0 255 }
CONSTANT: fg-color B{ 255 255 255 255 }
: in-bounds? ( loc -- ? )
dup { 0 0 } ${ size 1 - dup } vclamp = ;
: move ( loc -- loc' )
dup 2 [ { 1 -1 } random ] replicate v+ dup in-bounds?
[ nip ] [ drop ] if ;
: grow ( particles -- particles' )
spawns random dup
[ 2over swap in? ] [ drop dup move swap ] until nip
swap [ adjoin ] keep ;
: brownian-data ( -- seq )
HS{ $ seed } clone num-particles 1 - [ grow ] times { }
set-like ;
: blank-bitmap ( -- bitmap )
size sq [ bg-color ] replicate B{ } concat-as ;
: init-img ( -- img )
<image>
${ size size } >>dim
BGRA >>component-order
ubyte-components >>component-type
blank-bitmap >>bitmap ;
: brownian-img ( -- img )
init-img dup brownian-data
[ swap [ fg-color swap first2 ] dip set-pixel-at ] with each
;
: save-brownian-tree-image ( -- )
brownian-img "brownian.png" save-graphic-image ;
MAIN: save-brownian-tree-image

138
Task/Bulls-and-cows/Elena/bulls-and-cows.elena
View file

@ -3,88 +3,90 @@ import extensions;
class GameMaster
{
object theNumbers;
object theAttempt;
field _numbers;
field _attempt;
constructor()
{
// generate secret number
var randomNumbers := new int[]{1,2,3,4,5,6,7,8,9}.randomize(9);
constructor()
{
// generate secret number
var randomNumbers := new int[]{1,2,3,4,5,6,7,8,9}.randomize(9);
theNumbers := randomNumbers.Subarray(0, 4);
theAttempt := new Integer(1);
}
_numbers := randomNumbers.Subarray(0, 4);
_attempt := new Integer(1);
}
ask()
{
var row := console.print("Your Guess #",theAttempt," ?").readLine();
ask()
{
var row := console.print("Your Guess #",_attempt," ?").readLine();
^ row.toArray()
}
^ row.toArray()
}
proceed(guess)
{
int cows := 0;
int bulls := 0;
proceed(guess)
{
int cows := 0;
int bulls := 0;
if (guess.Length != 4)
{
if (guess.Length != 4)
{
bulls := -1
}
else
{
try
{
for (int i := 0, i < 4, i+=1) {
var ch := guess[i];
var number := ch.toString().toInt();
// check range
ifnot (number > 0 && number < 10)
{ InvalidArgumentException.raise() };
// check duplicates
var duplicate := guess.seekEach:(x => (x == ch)&&(x.equalReference(ch).Inverted));
if (nil != duplicate)
{
InvalidArgumentException.raise()
};
if (number == _numbers[i])
{
bulls += 1
}
else
{
if (_numbers.ifExists(number))
{ cows += 1 }
}
}
}
catch(Exception e)
{
bulls := -1
}
else
{
try
{
for (int i := 0, i < 4, i+=1) {
var ch := guess[i];
var number := ch.toString().toInt();
}
};
// check range
ifnot (number > 0 && number < 10)
{ InvalidArgumentException.raise() };
bulls =>
-1 { console.printLine:"Not a valid guess."; ^ true }
4 { console.printLine:"Congratulations! You have won!"; ^ false }
: {
_attempt.append(1);
// check duplicates
var duplicate := guess.seekEach:(x => (x == ch)&&(x.equalReference(ch).Inverted));
if (nil != duplicate)
{
InvalidArgumentException.raise()
};
console.printLine("Your Score is ",bulls," bulls and ",cows," cows");
if (number == theNumbers[i])
{
bulls += 1
}
else
{
if (theNumbers.ifExists(number))
{ cows += 1 }
}
}
}
catch(Exception e)
{
bulls := -1
}
};
bulls =>
-1 { console.printLine:"Not a valid guess."; ^ true }
4 { console.printLine:"Congratulations! You have won!"; ^ false }
: {
theAttempt.append(1);
console.printLine("Your Score is ",bulls," bulls and ",cows," cows");
^ true
}
}
^ true
}
}
}
public program()
{
var gameMaster := new GameMaster();
var gameMaster := new GameMaster();
(lazy:gameMaster.proceed(gameMaster.ask())).doWhile();
var process := $lazy gameMaster.proceed(gameMaster.ask());
console.readChar()
process.doWhile();
console.readChar()
}

7
Task/CRC-32/Zig/crc-32.zig Normal file
View file

@ -0,0 +1,7 @@
const std = @import("std");
const Crc32Ieee = std.hash.Crc32;
pub fn main() !void {
var res: u32 = Crc32Ieee.hash("The quick brown fox jumps over the lazy dog");
std.debug.print("{x}\n", .{res});
}

69
Task/Caesar-cipher/COBOL/caesar-cipher-1.cobol
View file

@ -1,37 +1,36 @@
identification division.
program-id. caesar.
data division.
1 msg pic x(50)
value "The quick brown fox jumped over the lazy dog.".
1 offset binary pic 9(4) value 7.
1 from-chars pic x(52).
1 to-chars pic x(52).
1 tabl.
2 pic x(26) value "abcdefghijklmnopqrstuvwxyz".
2 pic x(26) value "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
2 pic x(26) value "abcdefghijklmnopqrstuvwxyz".
2 pic x(26) value "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
procedure division.
begin.
display msg
perform encrypt
display msg
perform decrypt
display msg
stop run
.
IDENTIFICATION DIVISION.
PROGRAM-ID. CAESAR.
encrypt.
move tabl (1:52) to from-chars
move tabl (1 + offset:52) to to-chars
inspect msg converting from-chars
to to-chars
.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MSG PIC X(50)
VALUE "The quick brown fox jumped over the lazy dog.".
01 OFFSET PIC 9(4) VALUE 7 USAGE BINARY.
01 FROM-CHARS PIC X(52).
01 TO-CHARS PIC X(52).
01 TABL.
02 PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz".
02 PIC X(26) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
02 PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz".
02 PIC X(26) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
decrypt.
move tabl (1 + offset:52) to from-chars
move tabl (1:52) to to-chars
inspect msg converting from-chars
to to-chars
.
end program caesar.
PROCEDURE DIVISION.
BEGIN.
DISPLAY MSG
PERFORM ENCRYPT
DISPLAY MSG
PERFORM DECRYPT
DISPLAY MSG
STOP RUN.
ENCRYPT.
MOVE TABL (1:52) TO FROM-CHARS
MOVE TABL (1 + OFFSET:52) TO TO-CHARS
INSPECT MSG CONVERTING FROM-CHARS TO TO-CHARS.
DECRYPT.
MOVE TABL (1 + OFFSET:52) TO FROM-CHARS
MOVE TABL (1:52) TO TO-CHARS
INSPECT MSG CONVERTING FROM-CHARS TO TO-CHARS.
END PROGRAM CAESAR.

76
Task/Caesar-cipher/COBOL/caesar-cipher-2.cobol
View file

@ -1,86 +1,84 @@
>>SOURCE FORMAT IS FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. caesar-cipher.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION encrypt
FUNCTION decrypt
.
FUNCTION decrypt.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 plaintext PIC X(50).
01 offset PIC 99.
01 offset USAGE BINARY-CHAR.
01 encrypted-str PIC X(50).
PROCEDURE DIVISION.
DISPLAY "Enter a message to encrypt: " NO ADVANCING
DISPLAY "Enter a message to encrypt: " WITH NO ADVANCING
ACCEPT plaintext
DISPLAY "Enter the amount to shift by: " NO ADVANCING
DISPLAY "Enter the amount to shift by: " WITH NO ADVANCING
ACCEPT offset
MOVE FUNCTION encrypt(offset, plaintext) TO encrypted-str
MOVE encrypt(offset, plaintext) TO encrypted-str
DISPLAY "Encrypted: " encrypted-str
DISPLAY "Decrypted: " FUNCTION decrypt(offset, encrypted-str)
.
DISPLAY "Decrypted: " decrypt(offset, encrypted-str).
END PROGRAM caesar-cipher.
IDENTIFICATION DIVISION.
FUNCTION-ID. encrypt.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION ALL INTRINSIC.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 i PIC 9(3).
01 a PIC 9(3).
01 i USAGE INDEX.
01 a USAGE BINARY-CHAR.
LINKAGE SECTION.
01 offset PIC 99.
01 offset USAGE BINARY-CHAR.
01 str PIC X(50).
01 encrypted-str PIC X(50).
PROCEDURE DIVISION USING offset, str RETURNING encrypted-str.
MOVE str TO encrypted-str
PERFORM VARYING i FROM 1 BY 1 UNTIL i > FUNCTION LENGTH(str)
IF encrypted-str (i:1) IS NOT ALPHABETIC OR encrypted-str (i:1) = SPACE
PERFORM VARYING i FROM 1 BY 1 UNTIL i > LENGTH(str)
IF str(i:1) IS NOT ALPHABETIC OR str(i:1) = SPACE
MOVE str(i:1) TO encrypted-str(i:1)
EXIT PERFORM CYCLE
END-IF
IF encrypted-str (i:1) IS ALPHABETIC-UPPER
MOVE FUNCTION ORD("A") TO a
IF str(i:1) IS ALPHABETIC-UPPER
MOVE ORD("A") TO a
ELSE
MOVE FUNCTION ORD("a") TO a
MOVE ORD("a") TO a
END-IF
MOVE FUNCTION CHAR(FUNCTION MOD(FUNCTION ORD(encrypted-str (i:1))
- a + offset, 26) + a)
TO encrypted-str (i:1)
MOVE CHAR(MOD(ORD(str(i:1)) - a + offset, 26) + a)
TO encrypted-str(i:1)
END-PERFORM
.
EXIT FUNCTION.
END FUNCTION encrypt.
IDENTIFICATION DIVISION.
FUNCTION-ID. decrypt.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION encrypt
.
FUNCTION encrypt.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 decrypt-offset PIC 99.
01 decrypt-offset USAGE BINARY-CHAR.
LINKAGE SECTION.
01 offset PIC 99.
01 offset USAGE BINARY-CHAR.
01 str PIC X(50).
01 decrypted-str PIC X(50).
PROCEDURE DIVISION USING offset, str RETURNING decrypted-str.
SUBTRACT 26 FROM offset GIVING decrypt-offset
MOVE FUNCTION encrypt(decrypt-offset, str) TO decrypted-str
.
SUBTRACT offset FROM 26 GIVING decrypt-offset
MOVE encrypt(decrypt-offset, str) TO decrypted-str
EXIT FUNCTION.
END FUNCTION decrypt.

22
Task/Caesar-cipher/Elena/caesar-cipher.elena
View file

@ -10,37 +10,37 @@ const int Key = 12;
class Encrypting : Enumerator
{
int theKey;
Enumerator theEnumerator;
int _key;
Enumerator _enumerator;
constructor(int key, string text)
{
theKey := key;
theEnumerator := text.enumerator();
_key := key;
_enumerator := text.enumerator();
}
bool next() => theEnumerator;
bool next() => _enumerator;
reset() => theEnumerator;
reset() => _enumerator;
enumerable() => theEnumerator;
enumerable() => _enumerator;
get()
get Value()
{
var ch := theEnumerator.get();
var ch := *_enumerator;
var index := Letters.indexOf(0, ch);
if (-1 < index)
{
^ Letters[(theKey+index).mod:26]
^ Letters[(_key+index).mod:26]
}
else
{
index := BigLetters.indexOf(0, ch);
if (-1 < index)
{
^ BigLetters[(theKey+index).mod:26]
^ BigLetters[(_key+index).mod:26]
}
else
{

16
Task/Caesar-cipher/GW-BASIC/caesar-cipher.basic Normal file
View file

@ -0,0 +1,16 @@
10 REM Caesar cipher
20 CLS
30 DEC$ = ""
40 TYPE$ = "cleartext "
50 PRINT "If decrypting enter "+"<d> "+" -- else press enter "; : INPUT DEC$
60 INPUT "Enter offset > "; IOFFSET
70 IF DEC$ = "d" THEN IOFFSET = 26-IOFFSET: TYPE$ = "ciphertext "
110 PRINT "Enter "+TYPE$+"> ";
120 INPUT CAD$
140 LONGITUD = LEN(CAD$)
150 FOR I = 1 TO LONGITUD
160 ITEMP = ASC(MID$(CAD$,I,1))
170 IF ITEMP > 64 AND ITEMP < 91 THEN ITEMP = ((ITEMP-65)+IOFFSET) MOD 26 : PRINT CHR$(ITEMP+65); : ELSE PRINT CHR$(ITEMP);
230 NEXT I
240 PRINT
250 END

21
Task/Caesar-cipher/Koka/caesar-cipher.koka Normal file
View file

@ -0,0 +1,21 @@
fun encode(s : string, shift : int)
fun encode-char(c)
if c < 'A' || (c > 'Z' && c < 'a') || c > 'z' return c
val base = if c < 'Z' then (c - 'A').int else (c - 'a').int
val rot = (base + shift) % 26
(rot.char + (if c < 'Z' then 'A' else 'a'))
s.map(encode-char)
fun decode(s: string, shift: int)
s.encode(0 - shift)
fun trip(s: string, shift: int)
s.encode(shift).decode(shift)
fun main()
"HI".encode(2).println
"HI".encode(20).println
"HI".trip(10).println
val enc = "The quick brown fox jumped over the lazy dog".encode(11)
enc.println
enc.decode(11).println

32
Task/Caesar-cipher/True-BASIC/caesar-cipher.basic Normal file
View file

@ -0,0 +1,32 @@
LET dec$ = ""
LET tipo$ = "cleartext "
PRINT "If decrypting enter 'd' -- else press enter ";
INPUT dec$
PRINT "Enter offset ";
INPUT llave
IF dec$ = "d" THEN
LET llave = 26 - llave
LET tipo$ = "ciphertext "
END IF
PRINT "Enter "; tipo$;
INPUT cadena$
LET cadena$ = UCASE$(cadena$)
LET longitud = LEN(cadena$)
FOR i = 1 TO longitud
!LET iTemp = ASC(MID$(cadena$,i,1)) 'QBasic
LET itemp = ORD((cadena$)[i:i+1-1][1:1]) !'True BASIC
IF iTemp > 64 AND iTemp < 91 THEN
!LET iTemp = ((iTemp - 65) + llave) MOD 26 'QBasic
LET iTemp = MOD(((iTemp - 65) + llave), 26) !'True BASIC
PRINT CHR$(iTemp + 65);
ELSE
PRINT CHR$(iTemp);
END IF
NEXT i
END

0
Task/Calculating-the-value-of-e/Kotlin/calculating-the-value-of-e.kotlin → Task/Calculating-the-value-of-e/Kotlin/calculating-the-value-of-e-1.kotlin
View file

7
Task/Calculating-the-value-of-e/Kotlin/calculating-the-value-of-e-2.kotlin Normal file
View file

@ -0,0 +1,7 @@
fun main() {
val e = (1..17).runningFold(1L, Long::times)
.asReversed() // summing smaller values first improves accuracy
.sumOf { 1.0 / it }
println(e)
println(e == kotlin.math.E)
}

34
Task/Calculating-the-value-of-e/Zig/calculating-the-value-of-e.zig
View file

@ -1,8 +1,8 @@
const std = @import("std");
const math = std.math;
const stdout = std.io.getStdOut().writer();
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
var n: u32 = 0;
var state: u2 = 0;
var p0: u64 = 0;
@ -30,17 +30,19 @@ pub fn main() !void {
state = 1;
},
}
var p2: u64 = undefined;
var q2: u64 = undefined;
if (@mulWithOverflow(u64, a, p1, &p2) or
@addWithOverflow(u64, p2, p0, &p2) or
@mulWithOverflow(u64, a, q1, &q2) or
@addWithOverflow(u64, q2, q0, &q2))
{
break;
}
try stdout.print("e ~= {d:>19} / {d:>19} = ", .{p2, q2});
try dec_print(stdout, p2, q2, 36);
const ov1 = @mulWithOverflow(a, p1);
if (ov1[1] != 0) break;
const ov2 = @addWithOverflow(ov1[0], p0);
if (ov2[1] != 0) break;
const ov3 = @mulWithOverflow(a, q1);
if (ov3[1] != 0) break;
const ov4 = @addWithOverflow(ov3[0], q0);
if (ov4[1] != 0) break;
const p2 = ov2[0];
const q2 = ov4[0];
try stdout.print("e ~= {d:>19} / {d:>19} = ", .{ p2, q2 });
try decPrint(stdout, p2, q2, 36);
try stdout.writeByte('\n');
p0 = p1;
p1 = p2;
@ -49,21 +51,21 @@ pub fn main() !void {
}
}
fn dec_print(ostream: anytype, num: u64, den: u64, prec: usize) !void {
fn decPrint(ostream: anytype, num: u64, den: u64, prec: usize) !void {
// print out integer part.
try ostream.print("{}.", .{num / den});
// arithmetic with the remainders is done with u128, as the
// multiply by 10 could potentially overflow a u64.
//
const m = @intCast(u128, den);
const m: u128 = @intCast(den);
var r = @as(u128, num) % m;
var dec: usize = 0; // decimal place we're in.
while (dec < prec and r > 0) {
const n = 10 * r;
r = n % m;
dec += 1;
const ch = @intCast(u8, n / m) + '0';
const ch = @as(u8, @intCast(n / m)) + '0';
try ostream.writeByte(ch);
}
}

222
Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena
View file

@ -4,158 +4,158 @@ import system'calendar;
import extensions;
import extensions'routines;
const MonthNames = new string[]{"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER",
"NOVEMBER","DECEMBER"};
const MonthNames = new string[]{"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"};
const DayNames = new string[]{"MO", "TU", "WE", "TH", "FR", "SA", "SU"};
class CalendarMonthPrinter
{
Date theDate;
TextBuilder theLine;
int theMonth;
int theYear;
ref<int> theRow;
Date _date;
TextBuilder _line;
int _month;
int _year;
Reference<int> _row;
constructor(year, month)
{
theMonth := month;
theYear := year;
theLine := new TextBuilder();
theRow := 0;
}
constructor(year, month)
{
_month := month;
_year := year;
_line := new TextBuilder();
_row := 0;
}
writeTitle()
{
theRow.Value := 0;
theDate := Date.new(theYear, theMonth, 1);
DayNames.forEach:(name)
{ theLine.print(" ",name) }
}
writeTitle()
{
_row.Value := 0;
_date := Date.new(_year, _month, 1);
writeLine()
{
theLine.clear();
DayNames.forEach:(name)
{ _line.print(" ",name) }
}
if (theDate.Month == theMonth)
{
var dw := theDate.DayOfWeek;
writeLine()
{
_line.clear();
theLine.writeCopies(" ",theDate.DayOfWeek == 0 ? 6 : (theDate.DayOfWeek - 1));
if (_date.Month == _month)
{
var dw := _date.DayOfWeek;
do
{
theLine.writePaddingLeft(theDate.Day.toPrintable(), $32, 3);
_line.writeCopies(" ",_date.DayOfWeek == 0 ? 6 : (_date.DayOfWeek - 1));
theDate := theDate.addDays:1
}
until(theDate.Month != theMonth || theDate.DayOfWeek == 1)
};
do
{
_line.writePaddingLeft(_date.Day.toPrintable(), $32, 3);
int length := theLine.Length;
if (length < 21)
{ theLine.writeCopies(" ", 21 - length) };
_date := _date.addDays:1
}
until(_date.Month != _month || _date.DayOfWeek == 1)
};
theRow.append(1)
}
int length := _line.Length;
if (length < 21)
{ _line.writeCopies(" ", 21 - length) };
indexer() = new Indexer
{
bool Available = theRow < 7;
_row.append(1)
}
int Index
{
get() = theRow.Value;
indexer() = new Indexer
{
bool Available = _row < 7;
set(int index)
{
if (index <= theRow)
{ self.writeTitle() };
int Index
{
get() = _row.Value;
while (index > theRow)
{ self.writeLine() }
}
}
set(int index)
{
if (index <= _row)
{ self.writeTitle() };
appendIndex(int index)
{
this self.Index := theRow.Value + index
}
while (index > _row)
{ self.writeLine() }
}
}
get int Length() { ^ 7 }
appendIndex(int index)
{
this self.Index := _row.Value + index
}
get() = self;
get int Length() { ^ 7 }
set(o) { NotSupportedException.raise() }
};
get Value() = self;
printTitleTo(output)
{
output.writePadding(MonthNames[theMonth - 1], $32, 21)
}
set Value(o) { NotSupportedException.raise() }
};
printTo(output)
{
output.write(theLine.Value)
}
printTitleTo(output)
{
output.writePadding(MonthNames[_month - 1], $32, 21)
}
printTo(output)
{
output.write(_line.Value)
}
}
class Calendar
{
int theYear;
int theRowLength;
int _year;
int _rowLength;
constructor new(int year)
{
theYear := year;
theRowLength := 3
}
constructor new(int year)
{
_year := year;
_rowLength := 3
}
printTo(output)
{
output.writePadding("[SNOOPY]", $32, theRowLength * 25);
output.writeLine();
output.writePadding(theYear.toPrintable(), $32, theRowLength * 25);
output.writeLine().writeLine();
printTo(output)
{
output.writePadding("[SNOOPY]", $32, _rowLength * 25);
output.writeLine();
output.writePadding(_year.toPrintable(), $32, _rowLength * 25);
output.writeLine().writeLine();
var rowCount := 12 / theRowLength;
var months := Array.allocate(rowCount).populate:(i =>
Array.allocate(theRowLength)
var rowCount := 12 / _rowLength;
var months := Array.allocate(rowCount).populate:(i =>
Array.allocate(_rowLength)
.populate:(j =>
new CalendarMonthPrinter(theYear, i * theRowLength + j + 1)));
new CalendarMonthPrinter(_year, i * _rowLength + j + 1)));
months.forEach:(row)
{
var r := row;
months.forEach:(row)
{
var r := row;
row.forEach:(month)
row.forEach:(month)
{
month.printTitleTo:output;
output.write:" "
};
output.writeLine();
ParallelEnumerator.new(row).forEach:(line)
{
line.forEach:(printer)
{
month.printTitleTo:output;
printer.printTo:output;
output.write:" "
output.write:" "
};
output.writeLine();
ParallelEnumerator.new(row).forEach:(line)
{
line.forEach:(printer)
{
printer.printTo:output;
output.write:" "
};
output.writeLine()
}
}
}
output.writeLine()
}
}
}
}
public program()
{
var calender := Calendar.new(console.write:"ENTER THE YEAR:".readLine().toInt());
var calender := Calendar.new(console.write:"ENTER THE YEAR:".readLine().toInt());
calender.printTo:console;
calender.printTo:console;
console.readChar()
console.readChar()
}

25
Task/Calkin-Wilf-sequence/Maxima/calkin-wilf-sequence.maxima Normal file
View file

@ -0,0 +1,25 @@
/* The function fusc is related to Calkin-Wilf sequence */
fusc(n):=block(
[k:n,a:1,b:0],
while k>0 do (if evenp(k) then (k:k/2,a:a+b) else (k:(k-1)/2,b:a+b)),
b)$
/* Calkin-Wilf function using fusc */
calkin_wilf(n):=fusc(n)/fusc(n+1)$
/* Function that given a nonnegative rational returns its position in the Calkin-Wilf sequence */
cf_bin(fracti):=block(
cf_list:cf(fracti),
cf_len:length(cf_list),
if oddp(cf_len) then cf_list:reverse(cf_list) else cf_list:reverse(append(at(cf_list,[cf_list[cf_len]=cf_list[cf_len]-1]),[1])),
makelist(lambda([x],if oddp(x) then makelist(1,j,1,cf_list[x]) else makelist(0,j,1,cf_list[x]))(i),i,1,length(cf_list)),
apply(append,%%),
apply("+",makelist(2^i,i,0,length(%%)-1)*reverse(%%)))$
/* Test cases */
/* 20 first terms of the sequence */
makelist(calkin_wilf(i),i,1,20);
/* Position of 83116/51639 in Calkin-Wilf sequence */
83116/51639$
cf_bin(%);

16
Task/Call-an-object-method/COBOL/call-an-object-method-1.cobol
View file

@ -1,7 +1,11 @@
*> INVOKE
INVOKE FooClass "someMethod" RETURNING bar *> Factory object
INVOKE foo-instance "anotherMethod" RETURNING bar *> Instance object
*> INVOKE statements.
INVOKE my-class "some-method" *> Factory object
USING BY REFERENCE some-parameter
RETURNING foo
INVOKE my-instance "another-method" *> Instance object
USING BY REFERENCE some-parameter
RETURNING foo
*> Inline method invocation
MOVE FooClass::"someMethod" TO bar *> Factory object
MOVE foo-instance::"anotherMethod" TO bar *> Instance object
*> Inline method invocation.
MOVE my-class::"some-method"(some-parameter) TO foo *> Factory object
MOVE my-instance::"another-method"(some-parameter) TO foo *> Instance object

2
Task/Call-an-object-method/COBOL/call-an-object-method-2.cobol
View file

@ -1,3 +1,3 @@
INVOKE foo-instance "FactoryObject" RETURNING foo-factory
INVOKE some-instance "FactoryObject" RETURNING foo-factory
*> foo-factory can be treated like a normal object reference.
INVOKE foo-factory "someMethod"

30
Task/Cartesian-product-of-two-or-more-lists/Applesoft-BASIC/cartesian-product-of-two-or-more-lists.basic Normal file
View file

@ -0,0 +1,30 @@
100 HOME : rem 10 CLS FOR Chipmunk Basic & GW-BASIC
110 DIM array(2,2)
120 array(1,1) = 1 : array(1,2) = 2
130 array(2,1) = 3 : array(2,2) = 4
140 GOSUB 190
150 array(1,1) = 3 : array(1,2) = 4
160 array(2,1) = 1 : array(2,2) = 2
170 GOSUB 190
180 END
190 rem SUB cartesian(list)
200 u1 = 2 : u2 = 2
210 FOR i = 1 TO u1
220 PRINT "{ ";
230 FOR j = 1 TO u2
240 PRINT array(i,j);
250 IF j < u1 THEN PRINT ", ";
260 NEXT j
270 PRINT "}";
280 IF i < u2 THEN PRINT " x ";
290 NEXT i
300 PRINT " = { ";
310 FOR i = 1 TO u1
320 FOR j = 1 TO u2
330 PRINT "{ "; array(1,i); ", "; array(2,j); "} ";
340 IF i < u2 THEN PRINT ", ";
350 IF i => u2 THEN IF j < u1 THEN PRINT ", ";
360 NEXT j
370 NEXT i
380 PRINT "}"
390 RETURN

33
Task/Cartesian-product-of-two-or-more-lists/BASIC256/cartesian-product-of-two-or-more-lists.basic Normal file
View file

@ -0,0 +1,33 @@
arraybase 1
subroutine cartesian(list)
u1 = list[?][]
u2 = list[][?]
for i = 1 to u1
print "{";
for j = 1 to u2
print list[i,j];
if j < u1 then print ", ";
next
print "}";
if i < u2 then print " x ";
next i
print " = { ";
for i = 1 to u1
for j = 1 to u2
print "{"; list[1, i]; ", "; list[2, j]; "} ";
if i < u2 then
print ", ";
else
if j < u1 then print ", ";
end if
next j
next i
print "}"
end subroutine
dim list1 = {{1,2},{3,4}}
dim list2 = {{3,4},{1,2}}
call cartesian(list1)
call cartesian(list2)
end

33
Task/Cartesian-product-of-two-or-more-lists/Chipmunk-Basic/cartesian-product-of-two-or-more-lists.basic Normal file
View file

@ -0,0 +1,33 @@
100 cls
110 dim array(2,2)
120 array(1,1) = 1 : array(1,2) = 2
130 array(2,1) = 3 : array(2,2) = 4
140 gosub 190
150 array(1,1) = 3 : array(1,2) = 4
160 array(2,1) = 1 : array(2,2) = 2
170 gosub 190
180 end
190 rem sub cartesian(list)
200 u1 = 2 : u2 = 2
210 for i = 1 to u1
220 print "{ ";
230 for j = 1 to u2
240 print array(i,j);
250 if j < u1 then print ", ";
260 next j
270 print "}";
280 if i < u2 then print " x ";
290 next i
300 print " = { ";
310 for i = 1 to u1
320 for j = 1 to u2
330 print "{ ";array(1,i);", ";array(2,j);"} ";
340 if i < u2 then
350 print ", ";
360 else
370 if j < u1 then print ", ";
380 endif
390 next j
400 next i
410 print "}"
420 return

30
Task/Cartesian-product-of-two-or-more-lists/GW-BASIC/cartesian-product-of-two-or-more-lists.basic Normal file
View file

@ -0,0 +1,30 @@
100 CLS
110 DIM ARR(2,2)
120 ARR(1,1) = (1) : ARR(1,2) = (2)
130 ARR(2,1) = (3) : ARR(2,2) = (4)
140 GOSUB 190
150 ARR(1,1) = 3 : ARR(1,2) = 4
160 ARR(2,1) = 1 : ARR(2,2) = 2
170 GOSUB 190
180 END
190 REM SUB cartesian(list)
200 U1 = 2 : U2 = 2
210 FOR I = 1 TO U1
220 PRINT "{";
230 FOR J = 1 TO U2
240 PRINT ARR(I,J);
250 IF J < U1 THEN PRINT ",";
260 NEXT J
270 PRINT "}";
280 IF I < U2 THEN PRINT " x ";
290 NEXT I
300 PRINT " = {";
310 FOR I = 1 TO U1
320 FOR J = 1 TO U2
330 PRINT "{"; ARR(1,I); ","; ARR(2,J); "}";
340 IF I < U2 THEN PRINT ", ";
350 IF I => U2 THEN IF J < U1 THEN PRINT ",";
360 NEXT J
370 NEXT I
380 PRINT "}"
390 RETURN

46
Task/Cartesian-product-of-two-or-more-lists/Gambas/cartesian-product-of-two-or-more-lists.gambas Normal file
View file

@ -0,0 +1,46 @@
Public array[2, 2] As Integer
Public Sub Main()
array[0, 0] = 1
array[0, 1] = 2
array[1, 0] = 3
array[1, 1] = 4
cartesian(array)
array[0, 0] = 3
array[0, 1] = 4
array[1, 0] = 1
array[1, 1] = 2
cartesian(array)
End
Sub cartesian(arr As Integer[])
Dim u1 As Integer = arr.Max - 2
Dim u2 As Integer = arr.Max - 2
Dim i As Integer, j As Integer
For i = 0 To u1
Print "{";
For j = 0 To u2
Print arr[i, j];
If j < u1 Then Print ",";
Next
Print "}";
If i < u2 Then Print " x ";
Next
Print " = {";
For i = 0 To u1
For j = 0 To u2
Print "{"; arr[0, i]; ","; arr[1, j]; "}";
If i < u2 Then
Print ", ";
Else
If j < u1 Then Print ", ";
End If
Next
Next
Print "}"
End Sub

8
Task/Cartesian-product-of-two-or-more-lists/Maxima/cartesian-product-of-two-or-more-lists-1.maxima Normal file
View file

@ -0,0 +1,8 @@
cartesian_product({1,2},{3,4});
/* {[1,3],[1,4],[2,3],[2,4]} */
cartesian_product({3,4},{1,2});
/* {[3,1],[3,2],[4,1],[4,2]} */
cartesian_product({1,2},{});
/* {} */
cartesian_product({},{1,2});
/* {} */

8
Task/Cartesian-product-of-two-or-more-lists/Maxima/cartesian-product-of-two-or-more-lists-2.maxima Normal file
View file

@ -0,0 +1,8 @@
cartesian_product_list([1,2],[3,4]);
/* [[1,3],[1,4],[2,3],[2,4]] */
cartesian_product_list([3,4],[1,2]);
/* [[3,1],[3,2],[4,1],[4,2]] */
cartesian_product_list([1,2],[]);
/* [] */
cartesian_product_list([],[1,2]);
/* [] */

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