Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -2,21 +2,21 @@ There are 100 doors in a row that are all initially closed.
|
|||
|
||||
You make 100 [[task feature::Rosetta Code:multiple passes|passes]] by the doors.
|
||||
|
||||
The first time through, visit every door and ''toggle'' the door (if the door is closed, open it; if it is open, close it).
|
||||
The first time through, visit every door and ''toggle'' the door (if the door is closed, open it; if it is open, close it).
|
||||
|
||||
The second time, only visit every 2<sup>nd</sup> door (door #2, #4, #6, ...), and toggle it.
|
||||
The second time, only visit every 2<sup>nd</sup> door (door #2, #4, #6, ...), and toggle it.
|
||||
|
||||
The third time, visit every 3<sup>rd</sup> door (door #3, #6, #9, ...), etc, until you only visit the 100<sup>th</sup> door.
|
||||
The third time, visit every 3<sup>rd</sup> door (door #3, #6, #9, ...), etc, until you only visit the 100<sup>th</sup> door.
|
||||
|
||||
|
||||
;Task:
|
||||
Answer the question: what state are the doors in after the last pass? Which are open, which are closed?
|
||||
Answer the question: what state are the doors in after the last pass? Which are open, which are closed?
|
||||
|
||||
|
||||
'''[[task feature::Rosetta Code:extra credit|Alternate]]:'''
|
||||
As noted in this page's [[Talk:100 doors|discussion page]], the only doors that remain open are those whose numbers are perfect squares.
|
||||
As noted in this page's [[Talk:100 doors|discussion page]], the only doors that remain open are those whose numbers are perfect squares.
|
||||
|
||||
Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed;
|
||||
Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed;
|
||||
however, as should be obvious, this defeats the intent of comparing implementations across programming languages.
|
||||
<br><br>
|
||||
|
||||
|
|
|
|||
92
Task/100-doors/8080-Assembly/100-doors-2.8080
Normal file
92
Task/100-doors/8080-Assembly/100-doors-2.8080
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
;------------------------------------------------------
|
||||
; useful equates
|
||||
;------------------------------------------------------
|
||||
wboot equ 0 ; jump to BIOS warm boot routine
|
||||
bdos equ 5 ; BDOS entry
|
||||
conout equ 2 ; BDOS console output function
|
||||
putstr equ 9 ; BDOS print string function
|
||||
ndoors equ 100
|
||||
;
|
||||
org 100h
|
||||
lxi sp,stack ; set our own stack
|
||||
lxi d,signon ; print signon message
|
||||
mvi c,putstr
|
||||
call bdos
|
||||
;
|
||||
; generate sequence of squares from 1 to specified limit
|
||||
;
|
||||
gensqr:
|
||||
lxi h,1 ; starting value of square
|
||||
lxi d,3 ; starting value of increment
|
||||
lxi b,ndoors+1
|
||||
sqrs2:
|
||||
call cmpbchl ; have we exceeded the limit?
|
||||
jnc done ; we're finished
|
||||
call putdec ; otherwise print current square
|
||||
mvi a,' ' ; separate with a space
|
||||
call putchr
|
||||
dad d ; square += incrememnt
|
||||
inx d ; increment += 2
|
||||
inx d
|
||||
jmp sqrs2 ; repeat until finished
|
||||
;
|
||||
done: jmp wboot ; exit to command prompt
|
||||
;
|
||||
;---------------------------------------------------
|
||||
; 16-bit unsigned comparison of HL and BC
|
||||
; if HL = BC then Z flag set
|
||||
; if HL < BC then CY flag set (NC if HL >= BC)
|
||||
;------------------------------------------------------
|
||||
cmpbchl:
|
||||
mov a,h
|
||||
cmp b
|
||||
rnz
|
||||
mov a,l
|
||||
cmp c
|
||||
ret
|
||||
;---------------------------------------------------
|
||||
; console output of char in A register
|
||||
;---------------------------------------------------
|
||||
putchr: push h
|
||||
push d
|
||||
push b
|
||||
mov e,a
|
||||
mvi c,conout
|
||||
call bdos
|
||||
pop b
|
||||
pop d
|
||||
pop h
|
||||
ret
|
||||
;---------------------------------------------------
|
||||
; Output decimal number to console
|
||||
; HL holds 16-bit unsigned binary number to print
|
||||
;---------------------------------------------------
|
||||
putdec: push b
|
||||
push d
|
||||
push h
|
||||
lxi b,-10
|
||||
lxi d,-1
|
||||
putdec2:
|
||||
dad b
|
||||
inx d
|
||||
jc putdec2
|
||||
lxi b,10
|
||||
dad b
|
||||
xchg
|
||||
mov a,h
|
||||
ora l
|
||||
cnz putdec ; recursive call
|
||||
mov a,e
|
||||
adi '0'
|
||||
call putchr
|
||||
pop h
|
||||
pop d
|
||||
pop b
|
||||
ret
|
||||
;---------------------------------------------------
|
||||
; data area and stack
|
||||
;---------------------------------------------------
|
||||
signon: db 'The open doors are: $'
|
||||
stack equ $+128 ; 64-level stack
|
||||
;
|
||||
end
|
||||
|
|
@ -5,11 +5,10 @@ namespace ConsoleApplication1
|
|||
{
|
||||
static void Main(string[] args)
|
||||
{
|
||||
// Arrays are initialized to their type default values; the default for bool is false
|
||||
// Use false to indicate closed door
|
||||
bool[] doors = new bool[100];
|
||||
|
||||
//Close all doors to start.
|
||||
for (int d = 0; d < 100; d++) doors[d] = false;
|
||||
|
||||
//For each pass...
|
||||
for (int p = 0; p < 100; p++)//number of passes
|
||||
{
|
||||
|
|
@ -24,7 +23,7 @@ namespace ConsoleApplication1
|
|||
}
|
||||
|
||||
//Output the results.
|
||||
Console.WriteLine("Passes Completed!!! Here are the results: \r\n");
|
||||
Console.WriteLine("Passes Completed!!! Here are the results:");
|
||||
for (int d = 0; d < 100; d++)
|
||||
{
|
||||
if (doors[d])
|
||||
|
|
|
|||
|
|
@ -1,19 +1,14 @@
|
|||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
|
||||
int main()
|
||||
{
|
||||
int square = 1, increment = 3, door;
|
||||
for (door = 1; door <= 100; ++door)
|
||||
{
|
||||
printf("door #%d", door);
|
||||
if (door == square)
|
||||
{
|
||||
printf(" is open.\n");
|
||||
square += increment;
|
||||
increment += 2;
|
||||
}
|
||||
else
|
||||
printf(" is closed.\n");
|
||||
}
|
||||
return 0;
|
||||
int main() {
|
||||
uint32_t doorBytes[4] = {0};
|
||||
|
||||
for (uint32_t i = 1; i <= 100; ++i)
|
||||
for (uint32_t j = i - 1; j <= 99; j += i)
|
||||
doorBytes[j % 4] ^= (uint32_t)1 << j / 4;
|
||||
|
||||
for (uint32_t i = 0; i <= 99; doorBytes[i++ % 4] >>= 1)
|
||||
if (doorBytes[i % 4] & 1)
|
||||
printf("door %d is open\n", i + 1);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,8 +2,18 @@
|
|||
|
||||
int main()
|
||||
{
|
||||
int door, square, increment;
|
||||
for (door = 1, square = 1, increment = 1; door <= 100; door++ == square && (square += increment += 2))
|
||||
printf("door #%d is %s.\n", door, (door == square? "open" : "closed"));
|
||||
int square = 1, increment = 3, door;
|
||||
for (door = 1; door <= 100; ++door)
|
||||
{
|
||||
printf("door #%d", door);
|
||||
if (door == square)
|
||||
{
|
||||
printf(" is open.\n");
|
||||
square += increment;
|
||||
increment += 2;
|
||||
}
|
||||
else
|
||||
printf(" is closed.\n");
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,9 +2,8 @@
|
|||
|
||||
int main()
|
||||
{
|
||||
int i;
|
||||
for (i = 1; i * i <= 100; i++)
|
||||
printf("door %d open\n", i * i);
|
||||
|
||||
return 0;
|
||||
int door, square, increment;
|
||||
for (door = 1, square = 1, increment = 1; door <= 100; door++ == square && (square += increment += 2))
|
||||
printf("door #%d is %s.\n", door, (door == square? "open" : "closed"));
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
10
Task/100-doors/C/100-doors-6.c
Normal file
10
Task/100-doors/C/100-doors-6.c
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
#include <stdio.h>
|
||||
|
||||
int main()
|
||||
{
|
||||
int i;
|
||||
for (i = 1; i * i <= 100; i++)
|
||||
printf("door %d open\n", i * i);
|
||||
|
||||
return 0;
|
||||
}
|
||||
16
Task/100-doors/Emacs-Lisp/100-doors-2.l
Normal file
16
Task/100-doors/Emacs-Lisp/100-doors-2.l
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
(defun one-hundred-doors(initial-state)
|
||||
"Turn doors in INITIAL-STATE according to 100 Doors problem."
|
||||
(interactive "nEnter initial doors' state (as a number): ")
|
||||
(cl-loop for x from 1 to 100
|
||||
do (cl-loop for y from (1- x) to 99 by x
|
||||
do (setq initial-state (logxor initial-state (ash 1 y)))))
|
||||
(let ((counter 1)
|
||||
(open-doors nil))
|
||||
(while (> initial-state 0)
|
||||
(when (eq (mod initial-state 2) 1)
|
||||
(push counter open-doors))
|
||||
(cl-incf counter)
|
||||
(setq initial-state (/ initial-state 2)))
|
||||
(message "Open doors are %s" (reverse open-doors))))
|
||||
|
||||
(one-hundred-doors 0)
|
||||
|
|
@ -1 +1 @@
|
|||
writeln foldfrom(fn a, b, c: if(b: a~[c]; a), [], doors, series(1..len(doors)))
|
||||
writeln fold(doors, series(1..len(doors)), by=fn a, b, c: if(b: a~[c]; a), init=[])
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
writeln map(fn{^2}, 1..10)
|
||||
writeln map(1..10, by=fn{^2})
|
||||
|
|
|
|||
|
|
@ -1,14 +1,31 @@
|
|||
A flag list is a doubly linked list with a flag.
|
||||
A door is a flag list.
|
||||
A pass is a number.
|
||||
|
||||
To run:
|
||||
Start up.
|
||||
Pass doors given 1000 and 1000 passes.
|
||||
Shut down.
|
||||
|
||||
To pass doors given a count and some passes:
|
||||
Create some doors given the count.
|
||||
Loop.
|
||||
Add 1 to a counter.
|
||||
If the counter is greater than the passes, break.
|
||||
Go through the doors given the counter and the passes.
|
||||
Repeat.
|
||||
Output the states of the doors.
|
||||
Destroy the doors.
|
||||
|
||||
To create some doors given a count:
|
||||
Loop.
|
||||
If a counter is past the count, exit.
|
||||
Add 1 to a counter.
|
||||
If the counter is greater than the count, exit.
|
||||
Allocate memory for a door.
|
||||
Clear the door's flag.
|
||||
Append the door to the doors.
|
||||
Repeat.
|
||||
|
||||
A flag thing is a thing with a flag.
|
||||
A door is a flag thing.
|
||||
|
||||
To go through some doors given a number and some passes:
|
||||
Put 0 into a counter.
|
||||
Loop.
|
||||
|
|
@ -18,37 +35,23 @@ To go through some doors given a number and some passes:
|
|||
Invert the door's flag.
|
||||
Repeat.
|
||||
|
||||
To pick a door from some doors given a number:
|
||||
Loop.
|
||||
Add 1 to a counter.
|
||||
If the counter is greater than the number, exit.
|
||||
Get the door from the doors.
|
||||
If the door is nil, exit.
|
||||
Repeat.
|
||||
|
||||
To output the states of some doors:
|
||||
Loop.
|
||||
Bump a counter.
|
||||
Get a door from the doors.
|
||||
If the door is nil, exit.
|
||||
If the door's flag is set,
|
||||
Write "Door " then the counter then " is open" to the output;
|
||||
Write "Door " then the counter then " is open"
|
||||
then the CRLF string to StdOut;
|
||||
Repeat.
|
||||
Write "Door " then the counter then " is closed" to the output.
|
||||
\Write "Door " then the counter then " is closed"
|
||||
\then the CRLF string to StdOut.
|
||||
Repeat.
|
||||
|
||||
To pass doors given a count and some passes:
|
||||
Create some doors given the count.
|
||||
Loop.
|
||||
If a counter is past the passes, break.
|
||||
Go through the doors given the counter and the passes.
|
||||
Repeat.
|
||||
Output the states of the doors.
|
||||
Destroy the doors.
|
||||
|
||||
A pass is a number.
|
||||
|
||||
To pick a door from some doors given a number:
|
||||
Loop.
|
||||
If a counter is past the number, exit.
|
||||
Get the door from the doors.
|
||||
If the door is nil, exit.
|
||||
Repeat.
|
||||
|
||||
To run:
|
||||
Start up.
|
||||
Pass doors given 100 and 100 passes.
|
||||
Wait for the escape key.
|
||||
Shut down.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,11 @@
|
|||
import math
|
||||
|
||||
const number_doors = 101
|
||||
|
||||
fn main() {
|
||||
for i in 1..11 {
|
||||
print ( " Door ${i*i} is open.\n" )
|
||||
}
|
||||
max_i := int(math.sqrt(f64(number_doors - 1))) + 1
|
||||
for i in 1..max_i {
|
||||
door := i * i
|
||||
println("Door ${door} open")
|
||||
}
|
||||
}
|
||||
|
|
|
|||
5
Task/100-doors/V-(Vlang)/100-doors-4.v
Normal file
5
Task/100-doors/V-(Vlang)/100-doors-4.v
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
fn main() {
|
||||
for i in 1..11 {
|
||||
print ( " Door ${i*i} is open.\n" )
|
||||
}
|
||||
}
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
!yamlscript/v0
|
||||
!YS-v0
|
||||
|
||||
defn main():
|
||||
open =:
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
pub fn main() !void {
|
||||
const stdout = @import("std").io.getStdOut().writer();
|
||||
|
||||
var door: u8 = 1;
|
||||
while (door * door <= 100) : (door += 1) {
|
||||
for(1..11) |door| {
|
||||
try stdout.print("Door {d} is open\n", .{door * door});
|
||||
}
|
||||
}
|
||||
|
|
|
|||
66
Task/100-prisoners/ALGOL-68/100-prisoners.alg
Normal file
66
Task/100-prisoners/ALGOL-68/100-prisoners.alg
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
BEGIN # 100 prisoners #
|
||||
|
||||
CO begin code from the Knuth shuffle task CO
|
||||
PROC between = (INT a, b)INT :
|
||||
(
|
||||
ENTIER (random * ABS (b-a+1) + (a<b|a|b))
|
||||
);
|
||||
|
||||
PROC knuth shuffle = (REF[]INT a)VOID:
|
||||
(
|
||||
FOR i FROM LWB a TO UPB a DO
|
||||
INT j = between(LWB a, UPB a);
|
||||
INT t = a[i];
|
||||
a[i] := a[j];
|
||||
a[j] := t
|
||||
OD
|
||||
);
|
||||
CO end code from the Knuth shuffle task CO
|
||||
|
||||
INT number of prisoners = 100;
|
||||
|
||||
# tries to find the prisoners' numbers in the drawers, choosing drawers #
|
||||
# by the optimal strategy if `use optimal strategy` is TRUE or #
|
||||
# at random otherwise; returns TRUE if alll prisoners were found #
|
||||
# FALSE otherwise #
|
||||
PROC try drawers = ( BOOL use optimal strategy, REF[]INT drawers )BOOL:
|
||||
BEGIN
|
||||
BOOL found := TRUE;
|
||||
[ LWB drawers : UPB drawers ]BOOL tried;
|
||||
FOR prisoner TO number of prisoners WHILE found DO
|
||||
FOR i FROM LWB drawers TO UPB drawers DO tried[ i ] := FALSE OD;
|
||||
found := FALSE;
|
||||
INT drawer to try := IF use optimal strategy
|
||||
THEN prisoner
|
||||
ELSE between( LWB drawers, UPB drawers )
|
||||
FI;
|
||||
TO 50 WHILE NOT ( found := prisoner = drawers[ drawer to try ] ) DO
|
||||
tried[ drawer to try ] := TRUE;
|
||||
IF use optimal strategy THEN
|
||||
drawer to try := drawers[ drawer to try ]
|
||||
ELSE
|
||||
WHILE tried[ drawer to try ] DO
|
||||
drawer to try := between( LWB drawers, UPB drawers )
|
||||
OD
|
||||
FI
|
||||
OD
|
||||
OD;
|
||||
found
|
||||
END # try drawers # ;
|
||||
|
||||
BEGIN # run the random and optimal strategies and compare the successes #
|
||||
INT tests = 10 000; # number of times to try the strategies #
|
||||
INT random count := 0, optimal count := 0;
|
||||
[ 1 : 100 ]INT drawers;
|
||||
TO tests DO
|
||||
FOR i FROM LWB drawers TO UPB drawers DO drawers[ i ] := i OD;
|
||||
knuth shuffle( drawers );
|
||||
IF try drawers( FALSE, drawers ) THEN random count +:= 1 FI;
|
||||
IF try drawers( TRUE, drawers ) THEN optimal count +:= 1 FI
|
||||
OD;
|
||||
print( ( "100 prisoners: success rate via random choice: " ) );
|
||||
print( ( fixed( ( random count * 100 ) / tests, - 6, 2 ), "%", newline ) );
|
||||
print( ( " success rate via optimal choice: " ) );
|
||||
print( ( fixed( ( optimal count * 100 ) / tests, - 6, 2 ), "%", newline ) )
|
||||
END
|
||||
END
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
!yamlscript/v0
|
||||
!YS-v0
|
||||
|
||||
defn main(n=5000):
|
||||
:: https://rosettacode.org/wiki/100_prisoners
|
||||
|
|
|
|||
133
Task/15-puzzle-game/QBasic/15-puzzle-game.basic
Normal file
133
Task/15-puzzle-game/QBasic/15-puzzle-game.basic
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
DECLARE SUB printPuzzle ()
|
||||
DECLARE SUB buildBoard (level AS INTEGER)
|
||||
DECLARE FUNCTION introAndLevel! ()
|
||||
DECLARE FUNCTION isMoveValid! (piece AS INTEGER, piecePos AS INTEGER, emptyPos AS INTEGER)
|
||||
DECLARE FUNCTION piecePosition! (piece AS INTEGER)
|
||||
DECLARE FUNCTION isPuzzleComplete! ()
|
||||
|
||||
DIM SHARED d(16) AS INTEGER
|
||||
DIM SHARED dbp$(16) ' Board pieces
|
||||
DIM SHARED sh(3) AS INTEGER
|
||||
DIM level AS INTEGER, x AS INTEGER, y AS INTEGER, z AS INTEGER
|
||||
|
||||
' Main Program
|
||||
level = introAndLevel
|
||||
buildBoard (level)
|
||||
DO
|
||||
printPuzzle
|
||||
PRINT "To move a piece, enter its number (0 to quit): "
|
||||
INPUT x
|
||||
IF x = 0 THEN END
|
||||
|
||||
WHILE isMoveValid(x, y, z) = 0
|
||||
PRINT "Wrong move."
|
||||
printPuzzle
|
||||
PRINT "To move a piece, enter its number (0 to quit): "
|
||||
INPUT x
|
||||
IF x = 0 THEN END
|
||||
WEND
|
||||
|
||||
d(z) = x
|
||||
d(y) = 0
|
||||
CLS
|
||||
LOOP UNTIL isPuzzleComplete
|
||||
PRINT "YOU WON!"
|
||||
END
|
||||
|
||||
SUB buildBoard (level AS INTEGER)
|
||||
' Set pieces in correct order first
|
||||
FOR p = 1 TO 15
|
||||
d(p) = p
|
||||
NEXT p
|
||||
d(16) = 0 ' 0 = empty piece/slot
|
||||
z = 16 ' z = empty position
|
||||
|
||||
PRINT
|
||||
PRINT "Shuffling pieces";
|
||||
RANDOMIZE TIMER
|
||||
FOR n = 1 TO sh(level)
|
||||
PRINT ".";
|
||||
DO
|
||||
x = INT(RND * 4) + 1
|
||||
r = 0
|
||||
SELECT CASE x
|
||||
CASE 1: r = z - 4
|
||||
CASE 2: r = z + 4
|
||||
CASE 3: IF (z - 1) MOD 4 <> 0 THEN r = z - 1
|
||||
CASE 4: IF z MOD 4 <> 0 THEN r = z + 1
|
||||
END SELECT
|
||||
LOOP WHILE (r < 1) OR (r > 16)
|
||||
d(z) = d(r)
|
||||
z = r
|
||||
d(z) = 0
|
||||
NEXT n
|
||||
CLS
|
||||
END SUB
|
||||
|
||||
FUNCTION introAndLevel
|
||||
CLS
|
||||
sh(1) = 10
|
||||
sh(2) = 50
|
||||
sh(3) = 100
|
||||
PRINT "15 PUZZLE GAME": PRINT: PRINT
|
||||
PRINT "Please enter level of difficulty,"
|
||||
DO
|
||||
PRINT "1 (easy), 2 (medium) or 3 (hard): ";
|
||||
INPUT level
|
||||
LOOP WHILE (level < 1) OR (level > 3)
|
||||
introAndLevel = level
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION isMoveValid (piece AS INTEGER, piecePos AS INTEGER, emptyPos AS INTEGER)
|
||||
mv = 0
|
||||
IF (piece >= 1) AND (piece <= 15) THEN
|
||||
piecePos = piecePosition(piece)
|
||||
emptyPos = piecePosition(0)
|
||||
IF (piecePos - 4 = emptyPos) OR (piecePos + 4 = emptyPos) OR ((piecePos - 1 = emptyPos) AND (emptyPos MOD 4 <> 0)) OR ((piecePos + 1 = emptyPos) AND (piecePos MOD 4 <> 0)) THEN
|
||||
mv = 1
|
||||
END IF
|
||||
END IF
|
||||
isMoveValid = mv
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION isPuzzleComplete
|
||||
pc = 0
|
||||
p = 1
|
||||
WHILE (p < 16) AND (d(p) = p)
|
||||
p = p + 1
|
||||
WEND
|
||||
IF p = 16 THEN pc = 1
|
||||
isPuzzleComplete = pc
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION piecePosition (piece AS INTEGER)
|
||||
p = 1
|
||||
WHILE d(p) <> piece
|
||||
p = p + 1
|
||||
IF p > 16 THEN
|
||||
PRINT "UH OH!"
|
||||
STOP
|
||||
END IF
|
||||
WEND
|
||||
piecePosition = p
|
||||
END FUNCTION
|
||||
|
||||
SUB printPuzzle
|
||||
FOR p = 1 TO 16
|
||||
IF d(p) = 0 THEN
|
||||
dbp$(p) = " "
|
||||
ELSE
|
||||
dbp$(p) = RIGHT$(" " + LTRIM$(STR$(d(p))), 3) + " "
|
||||
END IF
|
||||
NEXT p
|
||||
|
||||
PRINT "+-----+-----+-----+-----+"
|
||||
PRINT "|"; dbp$(1); "|"; dbp$(2); "|"; dbp$(3); "|"; dbp$(4); "|"
|
||||
PRINT "+-----+-----+-----+-----+"
|
||||
PRINT "|"; dbp$(5); "|"; dbp$(6); "|"; dbp$(7); "|"; dbp$(8); "|"
|
||||
PRINT "+-----+-----+-----+-----+"
|
||||
PRINT "|"; dbp$(9); "|"; dbp$(10); "|"; dbp$(11); "|"; dbp$(12); "|"
|
||||
PRINT "+-----+-----+-----+-----+"
|
||||
PRINT "|"; dbp$(13); "|"; dbp$(14); "|"; dbp$(15); "|"; dbp$(16); "|"
|
||||
PRINT "+-----+-----+-----+-----+"
|
||||
END SUB
|
||||
312
Task/2048/Guile/2048.guile
Normal file
312
Task/2048/Guile/2048.guile
Normal file
|
|
@ -0,0 +1,312 @@
|
|||
;;require-module (ice-9 format)
|
||||
;;usage -> [~4d] <in> print-board
|
||||
;;
|
||||
(use-modules (ice-9 format))
|
||||
|
||||
;;require-module (srfi srfi-64)
|
||||
;;usage -> test-assert
|
||||
;;
|
||||
(use-modules (srfi srfi-64))
|
||||
|
||||
;;prodedure-name 2or4-generator
|
||||
;;input -> <$:nil>
|
||||
;;output -> _ (number)
|
||||
;;note -> "it only generates 2 or 4, with a 10% of outputting 4"
|
||||
;;
|
||||
(define 2or4-generator
|
||||
(lambda ()
|
||||
(let ([random-number (random 10)])
|
||||
(if (zero? random-number)
|
||||
4
|
||||
2))))
|
||||
|
||||
;;procedure-name print-board
|
||||
;;input -> board (array::4*4)
|
||||
;;output -> <$:nil>
|
||||
;;
|
||||
(define print-board
|
||||
(lambda (board)
|
||||
(do ((i 0 (1+ i)))
|
||||
((> i 3))
|
||||
(do ((j 0 (1+ j)))
|
||||
((> j 3))
|
||||
(format #t "[~4d]" (array-ref board i j)))
|
||||
(newline))))
|
||||
|
||||
;;procedure-name spawn!
|
||||
;;input -> 4x4board (array::4*4)
|
||||
;;output -> <$:nil>
|
||||
;;
|
||||
(define spawn!
|
||||
(lambda (4x4board)
|
||||
(let ([indexes '()])
|
||||
(do ((i 0 (1+ i)))
|
||||
((> i 3))
|
||||
(do ((j 0 (1+ j)))
|
||||
((> j 3))
|
||||
(when (zero? (array-ref 4x4board i j))
|
||||
(set! indexes (cons (cons i j) indexes)))))
|
||||
(let* ([indexes-length (length indexes)]
|
||||
[used-index-index (random indexes-length)]
|
||||
[used-index-pair (list-ref indexes used-index-index)])
|
||||
(array-set! 4x4board (2or4-generator) (car used-index-pair) (cdr used-index-pair))))))
|
||||
|
||||
;;procedure-name ask-user
|
||||
;;input -> valid-moves (list:symbol)
|
||||
;;output -> _ (symbol) [(memq <$:self:_> (list 'up 'down 'left 'right)) => #t]
|
||||
;;note -> "this procedure assumes there is at least one valid move"
|
||||
;;
|
||||
(define ask-user
|
||||
(lambda (valid-moves)
|
||||
(let loop ()
|
||||
(let ([option (read)])
|
||||
(if (memq option valid-moves)
|
||||
(case option
|
||||
[(up) 'up]
|
||||
[(down) 'down]
|
||||
[(left) 'left]
|
||||
[(right) 'right]
|
||||
[else (begin
|
||||
(display "wrong input! Please type up, down, left, or right only!")
|
||||
(newline)
|
||||
(loop))])
|
||||
(begin
|
||||
(display "please use valid moves!")
|
||||
(newline)
|
||||
(display "valid moves: ")
|
||||
(display valid-moves)
|
||||
(newline)
|
||||
(loop)))))))
|
||||
|
||||
;;procedure-name update-row!
|
||||
;;input -> row (array::1*4)
|
||||
;;output -> <$:nil>
|
||||
;;
|
||||
(define update-row!
|
||||
(lambda (row)
|
||||
(unless (array-equal? row #(0 0 0 0))
|
||||
(let ([lst '()] [l 0])
|
||||
(when (not (zero? (array-ref row 3))) (set! l (1+ l)) (set! lst (cons (array-ref row 3) lst)))
|
||||
(when (not (zero? (array-ref row 2))) (set! l (1+ l)) (set! lst (cons (array-ref row 2) lst)))
|
||||
(when (not (zero? (array-ref row 1))) (set! l (1+ l)) (set! lst (cons (array-ref row 1) lst)))
|
||||
(when (not (zero? (array-ref row 0))) (set! l (1+ l)) (set! lst (cons (array-ref row 0) lst)))
|
||||
(do ((i 0 (1+ i)))
|
||||
((>= i (- 4 l)))
|
||||
(array-set! row 0 i))
|
||||
(do ((i (- 4 l) (1+ i)) (j 0 (1+ j)))
|
||||
((>= i 4))
|
||||
(array-set! row (list-ref lst j) i)))
|
||||
(if (= (array-ref row 3) (array-ref row 2))
|
||||
(begin (array-set! row (+ (array-ref row 3) (array-ref row 2)) 3)
|
||||
(array-set! row (array-ref row 1) 2)
|
||||
(array-set! row (array-ref row 0) 1)
|
||||
(array-set! row 0 0)
|
||||
(when (= (array-ref row 2) (array-ref row 1))
|
||||
(array-set! row (+ (array-ref row 2) (array-ref row 1)) 2)
|
||||
(array-set! row 0 1)))
|
||||
(if (= (array-ref row 2) (array-ref row 1))
|
||||
(begin (array-set! row (+ (array-ref row 2) (array-ref row 1)) 2)
|
||||
(array-set! row (array-ref row 0) 1)
|
||||
(array-set! row 0 0))
|
||||
(when (= (array-ref row 1) (array-ref row 0))
|
||||
(array-set! row (+ (array-ref row 1) (array-ref row 0)) 1)
|
||||
(array-set! row 0 0)))))))
|
||||
|
||||
;;procedure-name update-board!
|
||||
;;input -> board (array::4*4)
|
||||
;;output -> <$:nil>
|
||||
;;note -> "this procedure can assume that the opertion is shifting the piles right"
|
||||
;;
|
||||
(define update-board!
|
||||
(lambda (board)
|
||||
(do ((i 0 (1+ i)))
|
||||
((>= i 4))
|
||||
(update-row! (array-cell-ref board i)))))
|
||||
|
||||
;;procedure-name row-can-shift-qright?
|
||||
;;input -> row (array::1*4)
|
||||
;;output -> _ (#t or #f)
|
||||
;;
|
||||
(define row-can-shift-right?
|
||||
(lambda (row)
|
||||
(if (and (zero? (array-ref row 0))
|
||||
(zero? (array-ref row 1))
|
||||
(zero? (array-ref row 2)))
|
||||
#f
|
||||
(if (or (zero? (array-ref row 3))
|
||||
(and (not (zero? (array-ref row 0))) (member 0 (list
|
||||
(array-ref row 1)
|
||||
(array-ref row 2)
|
||||
(array-ref row 3))))
|
||||
(and (not (zero? (array-ref row 1))) (member 0 (list
|
||||
(array-ref row 2)
|
||||
(array-ref row 3))))
|
||||
(and (not (zero? (array-ref row 2))) (member 0 (list
|
||||
(array-ref row 3)))))
|
||||
#t
|
||||
(if (or (and (not (zero? (array-ref row 0))) (= (array-ref row 0) (array-ref row 1)))
|
||||
(and (not (zero? (array-ref row 1))) (= (array-ref row 1) (array-ref row 2)))
|
||||
(and (not (zero? (array-ref row 2))) (= (array-ref row 2) (array-ref row 3))))
|
||||
#t
|
||||
#f)))))
|
||||
|
||||
(define test-row-can-shift-right?
|
||||
(lambda ()
|
||||
(test-begin "row-can-shift-right? test")
|
||||
(test-assert (row-can-shift-right? #(2 0 0 0)))
|
||||
(test-assert (row-can-shift-right? #(0 2 0 0)))
|
||||
(test-assert (row-can-shift-right? #(0 0 2 0)))
|
||||
(test-assert (not (row-can-shift-right? #(0 0 0 2))))
|
||||
(test-assert (row-can-shift-right? #(4 2 0 0)))
|
||||
(test-assert (row-can-shift-right? #(2 0 0 2)))
|
||||
(test-assert (row-can-shift-right? #(1024 8 2 2)))
|
||||
(test-end "row-can-shift-right? test")))
|
||||
|
||||
;;procedure-name can-shift-right?
|
||||
;;input -> board (array::4*4)
|
||||
;;output -> _ (#t or #f)
|
||||
;;
|
||||
(define can-shift-right?
|
||||
(lambda (board)
|
||||
(or (row-can-shift-right? (array-cell-ref board 0))
|
||||
(row-can-shift-right? (array-cell-ref board 1))
|
||||
(row-can-shift-right? (array-cell-ref board 2))
|
||||
(row-can-shift-right? (array-cell-ref board 3)))))
|
||||
|
||||
(define test-can-shift-right?
|
||||
(lambda ()
|
||||
(test-begin "can-shift-right? test")
|
||||
(test-assert (can-shift-right? #2((2 0 0 2)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0))))
|
||||
(test-assert (can-shift-right? #2((2 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(2 0 0 0))))
|
||||
(test-assert (not (can-shift-right? #2((2 8 4 8)
|
||||
(2 16 4 8)
|
||||
(0 0 0 4)
|
||||
(0 0 0 2)))))
|
||||
(test-end "can-shift-right? test")))
|
||||
|
||||
;;procedure-name valid-move?
|
||||
;;input -> board (array::4*4)
|
||||
;;output -> _ (symbol) [(eq? 'gameover <$:self:_>) => #t]
|
||||
;;output -> _ (list:symbol[1 or 2 or 3 or 4])
|
||||
;;note -> "the list symbol should only contain up, down, left, right"
|
||||
;;
|
||||
(define valid-move?
|
||||
(lambda (board)
|
||||
(let* ([output-lst '()]
|
||||
[rows board]
|
||||
[columns (make-shared-array rows
|
||||
(lambda (i j)
|
||||
(list j i))
|
||||
4 4)]
|
||||
[rows-reversed (make-shared-array rows
|
||||
(lambda (i j)
|
||||
(list i (- 3 j)))
|
||||
4 4)]
|
||||
[columns-reversed (make-shared-array columns
|
||||
(lambda (i j)
|
||||
(list i (- 3 j)))
|
||||
4 4)])
|
||||
(when (can-shift-right? rows) (set! output-lst (append (list 'right) output-lst)))
|
||||
(when (can-shift-right? rows-reversed) (set! output-lst (append (list 'left) output-lst)))
|
||||
(when (can-shift-right? columns) (set! output-lst (append (list 'down) output-lst)))
|
||||
(when (can-shift-right? columns-reversed) (set! output-lst (append (list 'up) output-lst)))
|
||||
(if (null? output-lst)
|
||||
'gameover
|
||||
output-lst))))
|
||||
|
||||
(define test-valid-move?
|
||||
(lambda ()
|
||||
(test-begin "valid-move? test")
|
||||
(test-assert (eq? 'gameover (valid-move? #2((8 4 2 16)
|
||||
(2 8 4 32)
|
||||
(4 2 8 16)
|
||||
(128 4 16 64)))))
|
||||
(test-assert (equal? (list 'up 'down 'left 'right) (valid-move? #2((0 0 0 0)
|
||||
(0 2 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 2)))))
|
||||
(test-end "valid-move? test")))
|
||||
|
||||
;;prodedure-name check-game-status!
|
||||
;;input -> board (array::4*4)
|
||||
;;output -> _ (symbol)
|
||||
;;note -> "The thing this procedure should implement: 1.decide whether there is a 2048 tile on board, if so, return 'win 2.decide the valid moves next time and return them as a list like (list 'up 'down 'right) or anything equivalent (if there is no valid moves, just return 'gameover)"
|
||||
;;
|
||||
(define check-game-status!
|
||||
(lambda (board)
|
||||
(spawn! board)
|
||||
(let ([all-tiles (list (array-ref board 0 0)
|
||||
(array-ref board 0 1)
|
||||
(array-ref board 0 2)
|
||||
(array-ref board 0 3)
|
||||
(array-ref board 1 0)
|
||||
(array-ref board 1 1)
|
||||
(array-ref board 1 2)
|
||||
(array-ref board 1 3)
|
||||
(array-ref board 2 0)
|
||||
(array-ref board 2 1)
|
||||
(array-ref board 2 2)
|
||||
(array-ref board 2 3)
|
||||
(array-ref board 3 0)
|
||||
(array-ref board 3 1)
|
||||
(array-ref board 3 2)
|
||||
(array-ref board 3 3))])
|
||||
(if (member 2048 all-tiles)
|
||||
'win
|
||||
(valid-move? board)))))
|
||||
|
||||
;;procedure-name play
|
||||
;;input -> <$:nil>
|
||||
;;output -> _ (array:4*4)
|
||||
;;
|
||||
(define play
|
||||
(lambda ()
|
||||
(set! *random-state* (random-state-from-platform))
|
||||
(let ([board (make-array 0 4 4)])
|
||||
(let* ([rows board]
|
||||
[columns (make-shared-array rows
|
||||
(lambda (i j)
|
||||
(list j i))
|
||||
4 4)]
|
||||
[rows-reversed (make-shared-array rows
|
||||
(lambda (i j)
|
||||
(list i (- 3 j)))
|
||||
4 4)]
|
||||
[columns-reversed (make-shared-array columns
|
||||
(lambda (i j)
|
||||
(list i (- 3 j)))
|
||||
4 4)])
|
||||
(spawn! rows)
|
||||
(let loop ([turn 1] [available-moves (valid-move? rows)])
|
||||
(format #t "TURN ~d" turn)
|
||||
(newline)
|
||||
(print-board rows)
|
||||
(case (ask-user available-moves)
|
||||
[(up) (update-board! columns-reversed)]
|
||||
[(down) (update-board! columns)]
|
||||
[(left) (update-board! rows-reversed)]
|
||||
[(right) (update-board! rows)]
|
||||
[else (error "something went wrong! The return stuff from (ask-user availuable-moves) is not among 'up 'down 'left 'right! This <else> normally should never be reached.")])
|
||||
(let ([symbols (check-game-status! rows)])
|
||||
(cond
|
||||
[(symbol? symbols) (case symbols
|
||||
[(win) (begin
|
||||
(display "You win!")
|
||||
(newline)
|
||||
(print-board rows))]
|
||||
[(gameover) (begin
|
||||
(display "You lose!")
|
||||
(newline)
|
||||
(print-board rows))]
|
||||
[else (error "While not intended, we named what the procedure (check-game-status rows) returned as symbols, checking it as a symbol which passed, then we get this. But we coded this to be 'win or 'gameover !")])]
|
||||
[(list? symbols) (begin
|
||||
(display "Valid moves: ")
|
||||
(display symbols)
|
||||
(newline)
|
||||
(loop (1+ turn) symbols))])))))))
|
||||
124
Task/24-game-Solve/FreeBASIC/24-game-solve.basic
Normal file
124
Task/24-game-Solve/FreeBASIC/24-game-solve.basic
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
Type GameState
|
||||
digitos(3) As Double
|
||||
operaciones(2) As String
|
||||
End Type
|
||||
|
||||
Function randomDigits() As String
|
||||
Dim As String resultado = ""
|
||||
For i As Integer = 0 To 3
|
||||
resultado &= Str(Int(Rnd * 9) + 1)
|
||||
Next
|
||||
Return resultado
|
||||
End Function
|
||||
|
||||
Function evaluate(digitos() As Double, operaciones() As String) As Double
|
||||
Dim As Double valor = digitos(0)
|
||||
|
||||
For i As Integer = 0 To 2
|
||||
Select Case operaciones(i)
|
||||
Case "+": valor += digitos(i +1)
|
||||
Case "-": valor -= digitos(i +1)
|
||||
Case "*": valor *= digitos(i +1)
|
||||
Case "/": If digitos(i +1) <> 0 Then valor /= digitos(i +1)
|
||||
End Select
|
||||
Next
|
||||
|
||||
Return valor
|
||||
End Function
|
||||
|
||||
Sub permute(digitos() As Double, soluciones() As GameState, Byref solutionCnt As Integer, k As Integer)
|
||||
Dim As String*1 opChars(3) = {"+", "-", "*", "/"}
|
||||
Dim As String ops(2)
|
||||
Dim As Integer i, j, l, m
|
||||
|
||||
If k = 4 Then
|
||||
For i = 0 To 3
|
||||
ops(0) = opChars(i)
|
||||
For j = 0 To 3
|
||||
ops(1) = opChars(j)
|
||||
For l = 0 To 3
|
||||
ops(2) = opChars(l)
|
||||
If Abs(evaluate(digitos(), ops()) - 24) < 0.001 Then
|
||||
With soluciones(solutionCnt)
|
||||
For m = 0 To 3: .digitos(m) = digitos(m): Next
|
||||
For m = 0 To 2: .operaciones(m) = ops(m): Next
|
||||
End With
|
||||
solutionCnt += 1
|
||||
Exit For 'Stop after first solution
|
||||
End If
|
||||
Next
|
||||
If solutionCnt Then Exit For
|
||||
Next
|
||||
If solutionCnt Then Exit For
|
||||
Next
|
||||
Else
|
||||
For i = k To 3
|
||||
Swap digitos(i), digitos(k)
|
||||
permute(digitos(), soluciones(), solutionCnt, k +1)
|
||||
If solutionCnt Then Exit For
|
||||
Swap digitos(k), digitos(i)
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
' Main program
|
||||
Randomize Timer
|
||||
Dim As Integer i
|
||||
Dim As String cmd
|
||||
Dim As Double digitos(3)
|
||||
Dim As String operaciones(2)
|
||||
|
||||
Do
|
||||
Cls
|
||||
Print "24 Game"
|
||||
Print "Generating 4 digitos..."
|
||||
|
||||
Dim As String inputDigits = randomDigits()
|
||||
Print "Make 24 using these digitos: ";
|
||||
For i = 1 To Len(inputDigits)
|
||||
Print Mid(inputDigits, i, 1); " ";
|
||||
Next
|
||||
Print
|
||||
|
||||
Line Input "Enter your expression (e.g. 4+5*3-2): ", cmd
|
||||
|
||||
Dim As Integer digitCnt = 0, opCnt = 0
|
||||
' Parse user input
|
||||
For i = 1 To Len(cmd)
|
||||
Select Case Mid(cmd, i, 1)
|
||||
Case "1" To "9"
|
||||
digitos(digitCnt) = Val(Mid(cmd, i, 1))
|
||||
digitCnt += 1
|
||||
Case "+", "-", "*", "/"
|
||||
operaciones(opCnt) = Mid(cmd, i, 1)
|
||||
opCnt += 1
|
||||
End Select
|
||||
Next
|
||||
|
||||
Dim As Double resultado = evaluate(digitos(), operaciones())
|
||||
Print "Your resultado: "; resultado
|
||||
|
||||
If Abs(resultado - 24) < 0.001 Then
|
||||
Print !"\nCongratulations, you found a solution!"
|
||||
Else
|
||||
Print !"\nThe valor of your expression is "; resultado; " instead of 24!"
|
||||
|
||||
Dim As GameState soluciones(1000)
|
||||
Dim As Integer solucCnt = 0
|
||||
|
||||
permute(digitos(), soluciones(), solucCnt, 0)
|
||||
|
||||
If solucCnt > 0 Then
|
||||
Print !"\nA possible solution could have been: ";
|
||||
With soluciones(0)
|
||||
Print .digitos(0) & .operaciones(0) & .digitos(1) & .operaciones(1) & .digitos(2) & .operaciones(2) & .digitos(3)
|
||||
End With
|
||||
Else
|
||||
Print !"\nThere was no known solution for these digitos."
|
||||
End If
|
||||
End If
|
||||
|
||||
Print !"\nDo you want to try again? (press N for exit, other key to continue)"
|
||||
Loop Until (Ucase(Input(1)) = "N")
|
||||
|
||||
Sleep
|
||||
|
|
@ -1,6 +1,5 @@
|
|||
print "Enter an equation in RPN form using all of, and"
|
||||
print "only the following single digits which evaluates"
|
||||
print "to 24. Only '*', '/', '+' and '-' are allowed:"
|
||||
print "Enter an equation in RPN form using all of, and only "
|
||||
print "the following single digits which evaluates to 24:"
|
||||
func game .
|
||||
len cnt[] 9
|
||||
write ">> "
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
require'misc'
|
||||
deal=: 1 + ? bind 9 9 9 9
|
||||
rules=: smoutput bind 'see http://en.wikipedia.org/wiki/24_Game'
|
||||
deal=: 1 + ? @ 9 9 9 9
|
||||
rules=: echo @ 'see http://en.wikipedia.org/wiki/24_Game'
|
||||
input=: prompt @ ('enter 24 expression using ', ":, ': '"_)
|
||||
|
||||
wellformed=: (' '<;._1@, ":@[) -:&(/:~) '(+-*%)' -.&;:~ ]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,36 @@
|
|||
[ swap dip [ 1+ split drop ]
|
||||
split nip ] is slice ( [ n n --> [ )
|
||||
|
||||
[ 0 swap witheach + ] is sum ( [ --> n )
|
||||
|
||||
[ slice sum join ] is square ( [ [ n n --> [ )
|
||||
|
||||
[ true swap
|
||||
behead swap witheach
|
||||
[ over = not if
|
||||
[ dip not conclude ] ]
|
||||
drop ] is same ( [ --> b )
|
||||
|
||||
[ [] temp put
|
||||
over - 1+ times
|
||||
[ dup i^ + temp gather ]
|
||||
drop
|
||||
temp take ] is low->high ( n n --> [ )
|
||||
|
||||
[ [] temp put
|
||||
witheach
|
||||
[ []
|
||||
over 0 1 square
|
||||
over 1 3 square
|
||||
over 3 5 square
|
||||
over 5 6 square
|
||||
same iff
|
||||
[ nested temp gather ]
|
||||
else drop ]
|
||||
temp take ] is task ( [ n --> [ )
|
||||
|
||||
1 7 low->high permutations task
|
||||
witheach [ echo cr ] cr
|
||||
3 9 low->high permutations task
|
||||
witheach [ echo cr ] cr
|
||||
0 9 low->high 7 arrangements task size echo
|
||||
|
|
@ -57,5 +57,3 @@ class BeerSong extends Song {
|
|||
return theLyrics;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
36
Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-2.ex
Normal file
36
Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-2.ex
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
last = [
|
||||
"""
|
||||
2 bottles of beer on the wall
|
||||
2 bottles of beer
|
||||
Take one down, pass it around
|
||||
1 bottle of beer on the wall
|
||||
""",
|
||||
"""
|
||||
1 bottle of beer on the wall
|
||||
1 bottle of beer
|
||||
Take one down, pass it around
|
||||
No bottles of beer on the wall
|
||||
""",
|
||||
"""
|
||||
No more bottles of beer on the wall
|
||||
No more bottles of beer
|
||||
Go to the store and buy some more
|
||||
99 bottles of beer on the wall
|
||||
"""
|
||||
]
|
||||
|
||||
skeleton = fn n ->
|
||||
"""
|
||||
#{n} bottles of beer on the wall
|
||||
#{n} bottles of beer
|
||||
Take one down, pass it around
|
||||
#{n - 1} bottles of beer on the wall
|
||||
"""
|
||||
end
|
||||
|
||||
99..3
|
||||
|> Stream.map(skeleton)
|
||||
|> Stream.concat(last)
|
||||
|> Enum.intersperse("\n")
|
||||
|> IO.iodata_to_binary()
|
||||
|> IO.puts()
|
||||
76
Task/99-bottles-of-beer/Java/99-bottles-of-beer-5.java
Normal file
76
Task/99-bottles-of-beer/Java/99-bottles-of-beer-5.java
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
import java.util.Scanner;
|
||||
|
||||
public class NineNineBottles {
|
||||
static int bottlesOfBeer = 99;
|
||||
static boolean hasBeer = true;
|
||||
static Scanner keyboard = new Scanner(System.in);
|
||||
|
||||
public static void main(String[] args) {
|
||||
beerCheck();
|
||||
keyboard.close();
|
||||
}
|
||||
|
||||
private static void beerCheck() {
|
||||
if(hasBeer) {
|
||||
party(bottlesOfBeer);
|
||||
}
|
||||
|
||||
if(!hasBeer) {
|
||||
System.out.println("Your ran out of beer. Would you like to go to the store?: ");
|
||||
String blurryVision, fallingOver, youAreDrunk;
|
||||
youAreDrunk = keyboard.nextLine();
|
||||
fallingOver = "RUHFO" + youAreDrunk.toLowerCase() + "RUHFOISafhur";
|
||||
blurryVision = fallingOver.split("[a-zA-Z]", 2).toString();
|
||||
if(blurryVision.contains("y"))
|
||||
blurryVision = blurryVision.substring(0, 1).toUpperCase();
|
||||
System.out.println("You entered: " + blurryVision.toString() + fallingOver);
|
||||
System.out.println("Did you mean yes?: ");
|
||||
blurryVision = keyboard.nextLine();
|
||||
if(blurryVision.contains("y") || blurryVision.contains("Y") || blurryVision.contains("8")
|
||||
|| blurryVision.contains("2") || blurryVision.equalsIgnoreCase(youAreDrunk))
|
||||
{String beRECcheeck = blurryVision.toLowerCase();
|
||||
if(beRECcheeck.equals("y")) {
|
||||
goToStore();
|
||||
beerCheck();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private static void party(int bottlesOfBeer) {
|
||||
while(bottlesOfBeer > 1) {
|
||||
putOnWall(bottlesOfBeer);
|
||||
bottlesOfBeer = takeOneDown(bottlesOfBeer);
|
||||
}
|
||||
putLastOnWall(bottlesOfBeer);
|
||||
}
|
||||
|
||||
private static void putOnWall(int bottlesOfBeer) {
|
||||
System.out.printf("%d bottles of beer on the wall%n", bottlesOfBeer);
|
||||
|
||||
}
|
||||
|
||||
private static int takeOneDown(int bottlesOfBeer) {
|
||||
System.out.printf("%d bottles of beer%n", bottlesOfBeer);
|
||||
System.out.println("Take one down, pass it around");
|
||||
bottlesOfBeer--;
|
||||
putOnWall(bottlesOfBeer);
|
||||
System.out.println();
|
||||
return bottlesOfBeer;
|
||||
|
||||
}
|
||||
|
||||
private static void putLastOnWall(int bottleOfBeer) {
|
||||
System.out.printf("%d bottle of beer on the wall%n", bottleOfBeer);
|
||||
System.out.printf("%d bottle of beer%n", bottleOfBeer);
|
||||
System.out.println("Take it down, pass it around");
|
||||
bottleOfBeer--;
|
||||
System.out.println("No more bottles of beer on the wall.");
|
||||
hasBeer = false;
|
||||
}
|
||||
|
||||
private static void goToStore() {
|
||||
bottlesOfBeer = 99;
|
||||
hasBeer = true;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
module main imports native.io.output.say
|
||||
module main
|
||||
import $native 'io' : output#sayn
|
||||
|
||||
for i|->{1,2..99;<|>) do
|
||||
say(""+i+" bottles of beer on the wall, "+i+" bottles of beer")
|
||||
say("Take one down and pass it around, "+(i-1)+" bottles of beer on the wall.")
|
||||
done
|
||||
|
||||
end
|
||||
funct main () : () =
|
||||
[1, 2; 99]#reverse#each {
|
||||
sayn "\(it) bottles of beer on the wall, \(it) bottles of beer";
|
||||
sayn "Take one down and pass it around, \(it# - 1) bottles of beer on the wall."
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
!yamlscript/v0
|
||||
!YS-v0
|
||||
|
||||
defn main(number=99):
|
||||
each num (number .. 1):
|
||||
|
|
|
|||
3
Task/A+B/Guile/a+b.guile
Normal file
3
Task/A+B/Guile/a+b.guile
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
;;;Actually, the solution is same as that of many other Lisp dialects here
|
||||
(+ (read) (read))
|
||||
;;Yes, it is neat but not strong, error prone actually. Other than this walkaround, if you dislike fetching a line in string format then parse the chars one by one by hand or byte by byte from stdin, you can use one read and do the work, with the price of typing (1 2) instead of 1 2 at the prompt since read would treat the input as a symbolic expression. So.,.there is sadly no easy way like scanf and %d %d in c unless one is willing to type ()s!
|
||||
9
Task/A+B/LOLCODE/a+b.lol
Normal file
9
Task/A+B/LOLCODE/a+b.lol
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
HAI 1.2
|
||||
I HAS A VAR1 ITZ A YARN BTW DECLARE A VARIABLE FOR LATER USE
|
||||
I HAS A VAR2 ITZ A YARN BTW DECLARE A VARIABLE FOR LATER USE
|
||||
VISIBLE "NUMBAH 1?"
|
||||
GIMMEH VAR1 BTW GET INPUT (NUMBER) INTO VARIABLE
|
||||
VISIBLE "NUMBAH 2?"
|
||||
GIMMEH VAR2 BTW GET INPUT (NUMBER) INTO VARIABLE
|
||||
VISIBLE SUM OF VAR1 AN VAR2
|
||||
KTHXBYE
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
module main
|
||||
imports native.io{input.hear,output.say}
|
||||
import $native 'io' [input#hear output#sayn]
|
||||
|
||||
vals a=hear(Int),b=hear(Int)
|
||||
say(a+b)
|
||||
|
||||
end
|
||||
funct main () : () =
|
||||
val read_int = {(hear ())#to_int#fold {0} {it}};
|
||||
val a = read_int ();
|
||||
val b = read_int ();
|
||||
sayn (a# + b)
|
||||
|
|
|
|||
|
|
@ -1,21 +1,42 @@
|
|||
To run:
|
||||
Start up.
|
||||
Read a number from the console.
|
||||
Read another number from the console.
|
||||
Output the sum of the number and the other number.
|
||||
Wait for the escape key.
|
||||
Set up the console.
|
||||
Write "Type the first number: " to Stdout.
|
||||
Read a buffer from stdin.
|
||||
Trim the buffer.
|
||||
If the buffer is not any integer,
|
||||
Write "Invalid input. Aborting Operation."
|
||||
then the CRLF string to StdOut;
|
||||
Shut down;
|
||||
Exit.
|
||||
Write "Type the second number: " to Stdout.
|
||||
Read a second buffer from stdin.
|
||||
Trim the second buffer.
|
||||
If the second buffer is not any integer,
|
||||
Write "Invalid input. Aborting Operation."
|
||||
then the CRLF string to StdOut;
|
||||
Shut down;
|
||||
Exit.
|
||||
Convert the buffer to a number.
|
||||
Convert the second buffer to a second number.
|
||||
Output the sum of the number and the second number.
|
||||
Shut down.
|
||||
|
||||
To output the sum of a number and another number:
|
||||
If the number is not valid,
|
||||
Write "Invalid input" to the console;
|
||||
Write "Invalid input. Aborting Operation."
|
||||
then the CRLF string to StdOut;
|
||||
Exit.
|
||||
If the other number is not valid,
|
||||
Write "Invalid input" to the console;
|
||||
Write "Invalid input. Aborting Operation."
|
||||
then the CRLF string to StdOut;
|
||||
Exit.
|
||||
Write the number plus the other number then " is the sum." to the console.
|
||||
Add the other number to the number.
|
||||
Convert the number to a string called result.
|
||||
Write "The sum is " then the result
|
||||
then the CRLF string to StdOut.
|
||||
|
||||
To decide if a number is valid:
|
||||
If the number is not greater than or equal to -1000, say no.
|
||||
If the number is not less than or equal to 1000, say no.
|
||||
If the number is less than -1000, say no.
|
||||
If the number is greater than 1000, say no.
|
||||
Say yes.
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
(A+B)
|
||||
comment:
|
||||
READ AND ADD
|
||||
#true
|
||||
(+) (read) (read)
|
||||
|
||||
(+) one two
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "+" one two
|
||||
|
||||
(read)
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(001) "read"
|
||||
|
|
|
|||
|
|
@ -1,25 +1,18 @@
|
|||
const std = @import("std");
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
|
||||
const Input = enum { a, b };
|
||||
|
||||
pub fn main() !void {
|
||||
var buf: [1024]u8 = undefined;
|
||||
const reader = std.io.getStdIn().reader();
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
try stdout.writeAll("Enter two integers separated by a space: ");
|
||||
const input = try reader.readUntilDelimiter(&buf, '\n');
|
||||
const values = std.mem.trim(u8, input, "\x20");
|
||||
const text = std.mem.trimRight(u8, input, "\r\n");
|
||||
|
||||
var count: usize = 0;
|
||||
var split: usize = 0;
|
||||
for (values, 0..) |c, i| {
|
||||
if (!std.ascii.isDigit(c)) {
|
||||
count += 1;
|
||||
if (count == 1) split = i;
|
||||
}
|
||||
}
|
||||
var it = std.mem.tokenizeScalar(u8, text, ' ');
|
||||
|
||||
const a = try std.fmt.parseInt(i64, it.next().?, 10);
|
||||
const b = try std.fmt.parseInt(i64, it.next().?, 10);
|
||||
|
||||
const a = try std.fmt.parseInt(u64, values[0..split], 10);
|
||||
const b = try std.fmt.parseInt(u64, values[split + count ..], 10);
|
||||
|
||||
try stdout.print("{d}\n", .{a + b});
|
||||
}
|
||||
|
|
|
|||
102
Task/AKS-test-for-primes/FutureBasic/aks-test-for-primes.basic
Normal file
102
Task/AKS-test-for-primes/FutureBasic/aks-test-for-primes.basic
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
// AKS Test for Primes task
|
||||
// https://rosettacode.org/wiki/AKS_test_for_primes
|
||||
// Translated from Yabasic to FutureBASIC
|
||||
|
||||
|
||||
#build ShowMoreWarnings NO
|
||||
|
||||
begin globals
|
||||
sInt64 c(100)
|
||||
//double n
|
||||
end globals
|
||||
|
||||
local fn coef(nx as short)
|
||||
// out-by-1, ie coef(1)==^0, coef(2)==^1, coef(3)==^2 etc.
|
||||
c(nx) = 1
|
||||
short i
|
||||
for i = nx-1 to 2 step -1
|
||||
c(i) = c(i) + c(i-1)
|
||||
next
|
||||
end fn
|
||||
|
||||
local fn is_prime(nx as short) as boolean
|
||||
short i
|
||||
bool result = _false
|
||||
fn coef(nx+1) // (I said it was out-by-1)
|
||||
for i = 2 to nx-1 // (technically "to n" is more correct)
|
||||
if int(c(i)/nx) <> c(i)/nx
|
||||
return _false
|
||||
end if
|
||||
next
|
||||
|
||||
result = _true
|
||||
end fn = result
|
||||
|
||||
local fn show(nx as short)
|
||||
// (As per coef, this is (working) out-by-1)
|
||||
|
||||
double ci
|
||||
str255 cix
|
||||
short i
|
||||
|
||||
for i = nx to 1 step -1
|
||||
ci = c(i)
|
||||
if ci = 1
|
||||
if (nx-i) mod 2 = 0
|
||||
if i = 1
|
||||
if nx = 1
|
||||
cix = " 1"
|
||||
else
|
||||
cix = "+1"
|
||||
end if
|
||||
else
|
||||
cix = ""
|
||||
end if
|
||||
else
|
||||
cix = "-1"
|
||||
end if
|
||||
else
|
||||
if (nx-i) mod 2 = 0
|
||||
cix = "+" + str$(ci)
|
||||
else
|
||||
cix = "-" + str$(ci)
|
||||
end if
|
||||
end if
|
||||
|
||||
if i = 1 // ie ^0
|
||||
print cix;
|
||||
else
|
||||
if i = 2 then print cix, "x"; // ie ^1
|
||||
if i <> 2 then print cix, "x^", i-1;
|
||||
end if
|
||||
|
||||
next i
|
||||
end fn
|
||||
|
||||
local fn AKS_test_for_primes
|
||||
short nx
|
||||
|
||||
for nx = 1 to 10 // (0 to 9 really)
|
||||
fn coef(nx)
|
||||
print "(x-1)^" + str$(nx-1) + " = ";
|
||||
fn show(nx)
|
||||
print
|
||||
next
|
||||
|
||||
print
|
||||
print "primes (<=53): ";
|
||||
short n
|
||||
c(2) = 1 // (this manages "", which is all that call did anyway...)
|
||||
for n = 2 to 53
|
||||
if fn is_prime(n)
|
||||
print " ", n;
|
||||
end if
|
||||
next
|
||||
print
|
||||
end fn
|
||||
|
||||
window 1,@"AKS test for Primes",fn CGRectMake(0, 0, 850, 200)
|
||||
|
||||
fn AKS_test_for_primes
|
||||
|
||||
handleevents
|
||||
|
|
@ -1,12 +1,14 @@
|
|||
parse version version; say version
|
||||
say 'AKS-test for Primes'; say
|
||||
include Settings
|
||||
|
||||
say version
|
||||
say 'AKS-test for primes'; say
|
||||
arg p
|
||||
if p = '' then
|
||||
p = 10
|
||||
numeric digits Max(10,Abs(p)%3)
|
||||
call Combis p
|
||||
call Polynomials p
|
||||
call ShowPrimes p
|
||||
call Showprimes p
|
||||
exit
|
||||
|
||||
Combis:
|
||||
|
|
@ -17,7 +19,7 @@ if p > 0 then
|
|||
say 'Combinations up to' p'...'
|
||||
else
|
||||
say 'Combinations for' Abs(p)'...'
|
||||
say Combinations(p) 'Combinations generated'
|
||||
say Combinations(p) 'combinations generated'
|
||||
say Format(Time('e'),,3) 'seconds'
|
||||
say
|
||||
return
|
||||
|
|
@ -33,9 +35,9 @@ else
|
|||
b = 0
|
||||
p = Abs(p); prim. = 0; n = 0
|
||||
do i = b to p
|
||||
a = Ppower('1 -1',i)
|
||||
a = Ppow('1 -1',i)
|
||||
if i < 11 then
|
||||
say '(x-1)^'i '=' Parray2formula()
|
||||
say '(x-1)^'i '=' Plst2form(Parr2lst())
|
||||
s = 1
|
||||
do j = 2 to poly.0-1
|
||||
a = poly.coef.j
|
||||
|
|
@ -56,7 +58,7 @@ say Format(Time('e'),,3) 'seconds'
|
|||
say
|
||||
return
|
||||
|
||||
ShowPrimes:
|
||||
Showprimes:
|
||||
procedure expose prim.
|
||||
arg p
|
||||
call Time('r')
|
||||
|
|
@ -64,9 +66,9 @@ say 'Primes...'
|
|||
if p < 0 then do
|
||||
p = Abs(p)
|
||||
if prim.0 > 0 then
|
||||
say p 'is Prime'
|
||||
say p 'is prime'
|
||||
else
|
||||
say p 'is not Prime'
|
||||
say p 'is not prime'
|
||||
end
|
||||
else do
|
||||
do i = 1 to prim.0
|
||||
|
|
@ -80,124 +82,8 @@ say Format(Time('e'),,3) 'seconds'
|
|||
say
|
||||
return
|
||||
|
||||
Combinations:
|
||||
/* Combinations */
|
||||
procedure expose comb.
|
||||
arg xx
|
||||
/* Validate */
|
||||
if \ Whole(xx) then say abend
|
||||
/* Recurring definition */
|
||||
comb. = 1
|
||||
if xx < 0 then do
|
||||
xx = -xx; m = xx%2; a = 1
|
||||
do i = 1 to m
|
||||
a = a*(xx-i+1)/i; comb.xx.i = a
|
||||
end
|
||||
do i = m+1 to xx-1
|
||||
j = xx-i; comb.xx.i = comb.xx.j
|
||||
end
|
||||
return xx+1
|
||||
end
|
||||
else do
|
||||
do i = 1 to xx
|
||||
i1 = i-1
|
||||
do j = 1 to i1
|
||||
j1 = j-1; comb.i.j = comb.i1.j1+comb.i1.j
|
||||
end
|
||||
end
|
||||
return (xx*xx+3*xx+2)/2
|
||||
end
|
||||
|
||||
Ppower:
|
||||
/* Exponentiation */
|
||||
procedure expose poly. comb. work.
|
||||
arg x,y
|
||||
/* Validate */
|
||||
if x = '' then say abend
|
||||
if \ Whole(y) then say abend
|
||||
if y < 0 then say abend
|
||||
/* Exponentiate */
|
||||
numeric digits Digits()+2
|
||||
wx = Words(x); wm = wx*y-y+1
|
||||
poly. = 0; poly.0 = wm
|
||||
select
|
||||
when wx = 1 then
|
||||
/* Power of a number */
|
||||
poly.coef.1 = x**y
|
||||
when wx = 2 then do
|
||||
/* Newton's binomial */
|
||||
a = Word(x,1); b = Word(x,2)
|
||||
do i = 1 to wm
|
||||
j = y-i+1; k = i-1
|
||||
poly.coef.i = comb.y.k*a**j*b**k
|
||||
end
|
||||
end
|
||||
otherwise do
|
||||
/* Repeated multiplication */
|
||||
do i = 1 to wx
|
||||
poly.coef.1.i = Word(x,i)
|
||||
poly.coef.2.i = poly.coef.1.i
|
||||
end
|
||||
wy = wx
|
||||
do i = 2 to y
|
||||
work. = 0
|
||||
do j = 1 to wx
|
||||
do k = 1 to wy
|
||||
l = j+k-1; work.coef.l = work.coef.l+poly.coef.1.j*poly.coef.2.k
|
||||
end
|
||||
end
|
||||
if i = y then
|
||||
leave i
|
||||
wx = wx+wy-1
|
||||
do j = 1 to wx
|
||||
poly.coef.1.j = work.coef.j
|
||||
end
|
||||
end
|
||||
do i = 1 to wm
|
||||
poly.coef.i = work.coef.i
|
||||
end
|
||||
end
|
||||
end
|
||||
numeric digits Digits()-2
|
||||
/* Normalize coefs */
|
||||
call Pnormalize
|
||||
return wm
|
||||
|
||||
Parray2formula:
|
||||
/* Array -> Formula */
|
||||
procedure expose poly.
|
||||
/* Generate formula */
|
||||
y = ''; wm = poly.0
|
||||
do i = 1 to wm
|
||||
a = poly.coef.i
|
||||
if a <> 0 then do
|
||||
select
|
||||
when a < 0 then
|
||||
s = '-'
|
||||
when i > 1 then
|
||||
s = '+'
|
||||
otherwise
|
||||
s = ''
|
||||
end
|
||||
a = Abs(a); e = wm-i
|
||||
if a = 1 & e > 0 then
|
||||
a = ''
|
||||
select
|
||||
when e > 1 then
|
||||
b = 'x^'e
|
||||
when e = 1 then
|
||||
b = 'x'
|
||||
otherwise
|
||||
b = ''
|
||||
end
|
||||
y = y||s||a||b
|
||||
end
|
||||
end
|
||||
if y = '' then
|
||||
y = 0
|
||||
return Strip(y)
|
||||
|
||||
include Functions
|
||||
include Numbers
|
||||
include Polynomial
|
||||
include Sequences
|
||||
include Abend
|
||||
|
|
|
|||
|
|
@ -0,0 +1,84 @@
|
|||
100 cls
|
||||
110 type tableentry
|
||||
120 nombre as string *8
|
||||
130 bits as integer
|
||||
140 startpos as integer
|
||||
150 length as integer
|
||||
160 end type
|
||||
170 dim hexmap$(15)
|
||||
180 hexmap$(0) = "0000" : hexmap$(1) = "0001" : hexmap$(2) = "0010" : hexmap$(3) = "0011"
|
||||
190 hexmap$(4) = "0100" : hexmap$(5) = "0101" : hexmap$(6) = "0110" : hexmap$(7) = "0111"
|
||||
200 hexmap$(8) = "1000" : hexmap$(9) = "1001" : hexmap$(10) = "1010" : hexmap$(11) = "1011"
|
||||
210 hexmap$(12) = "1100" : hexmap$(13) = "1101" : hexmap$(14) = "1110" : hexmap$(15) = "1111"
|
||||
220 dim fields(12) as tableentry
|
||||
230 header$ = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
240 header$ = header$+" | ID |"+chr$(10)
|
||||
250 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
260 header$ = header$+" |QR| Opcode |AA|TC|RD|RA| Z | RCODE |"+chr$(10)
|
||||
270 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
280 header$ = header$+" | QDCOUNT |"+chr$(10)
|
||||
290 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
300 header$ = header$+" | ANCOUNT |"+chr$(10)
|
||||
310 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
320 header$ = header$+" | NSCOUNT |"+chr$(10)
|
||||
330 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10)
|
||||
340 header$ = header$+" | ARCOUNT |"+chr$(10)
|
||||
350 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"
|
||||
360 fields(0).nombre = " ID " : fields(0).bits = 16 : fields(0).startpos = 0 : fields(0).length = 16
|
||||
370 fields(1).nombre = " QR " : fields(1).bits = 1 : fields(1).startpos = 16 : fields(1).length = 1
|
||||
380 fields(2).nombre = " Opcode " : fields(2).bits = 4 : fields(2).startpos = 17 : fields(2).length = 4
|
||||
390 fields(3).nombre = " AA " : fields(3).bits = 1 : fields(3).startpos = 21 : fields(3).length = 1
|
||||
400 fields(4).nombre = " TC " : fields(4).bits = 1 : fields(4).startpos = 22 : fields(4).length = 1
|
||||
410 fields(5).nombre = " RD " : fields(5).bits = 1 : fields(5).startpos = 23 : fields(5).length = 1
|
||||
420 fields(6).nombre = " RA " : fields(6).bits = 1 : fields(6).startpos = 24 : fields(6).length = 1
|
||||
430 fields(7).nombre = " Z " : fields(7).bits = 3 : fields(7).startpos = 25 : fields(7).length = 3
|
||||
440 fields(8).nombre = " RCODE " : fields(8).bits = 4 : fields(8).startpos = 28 : fields(8).length = 4
|
||||
450 fields(9).nombre = "QDCOUNT " : fields(9).bits = 16 : fields(9).startpos = 32 : fields(9).length = 16
|
||||
460 fields(10).nombre = "ANCOUNT " : fields(10).bits = 16 : fields(10).startpos = 48 : fields(10).length = 16
|
||||
470 fields(11).nombre = "NSCOUNT " : fields(11).bits = 16 : fields(11).startpos = 64 : fields(11).length = 16
|
||||
480 fields(12).nombre = "ARCOUNT " : fields(12).bits = 16 : fields(12).startpos = 80 : fields(12).length = 16
|
||||
490 hexstr$ = "78477bbf5496e12e1bf169a4"
|
||||
500 binstr$ = hextobinary$(hexstr$)
|
||||
510 print "RFC 1035 message diagram header:"
|
||||
520 print header$
|
||||
530 print
|
||||
540 print " Decoded:"
|
||||
550 print " Name Bits Start End"
|
||||
560 print " ======= ==== ===== ==="
|
||||
570 for i = 0 to 12
|
||||
580 print " ";fields(i).nombre;" ";
|
||||
581 print using "####";fields(i).bits;" ";
|
||||
600 print using "#####";fields(i).startpos;" ";
|
||||
601 print using "###";fields(i).startpos+fields(i).length-1
|
||||
610 next i
|
||||
620 print
|
||||
630 print " Test string in hex:"
|
||||
640 print " ";hexstr$
|
||||
650 print
|
||||
660 print " Test string in binary:"
|
||||
670 print " ";binstr$
|
||||
680 print
|
||||
690 print " Unpacked:"
|
||||
700 print " Name Size Bit Pattern"
|
||||
710 print " ======= ==== ================"
|
||||
720 for i = 0 to 12
|
||||
730 bitpattern$ = mid$(binstr$,fields(i).startpos+1,fields(i).length)
|
||||
740 bitpattern$ = left$(bitpattern$+" ",16)
|
||||
760 print " ";fields(i).nombre;" ";
|
||||
770 print using "####";fields(i).bits;" ";
|
||||
780 print bitpattern$
|
||||
790 next i
|
||||
800 end
|
||||
810 sub hextobinary$(hexstring$)
|
||||
820 result$ = ""
|
||||
830 for i = 1 to len(hexstring$)
|
||||
840 hexdigit$ = ucase$(mid$(hexstring$,i,1))
|
||||
850 if hexdigit$ >= "0" and hexdigit$ <= "9" then
|
||||
860 idx = val(hexdigit$)
|
||||
870 else
|
||||
880 idx = asc(hexdigit$)-asc("A")+10
|
||||
890 endif
|
||||
900 if idx >= 0 and idx <= 15 then result$ = result$+hexmap$(idx)
|
||||
910 next i
|
||||
920 hextobinary$ = result$
|
||||
930 end sub
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
Type TableEntry
|
||||
nombre As String * 8
|
||||
bits As Integer
|
||||
startPos As Integer
|
||||
length As Integer
|
||||
End Type
|
||||
|
||||
Function HexToBinary(hexString As String) As String
|
||||
Dim As Integer i, idx
|
||||
Dim As String hexDigit, result = ""
|
||||
|
||||
' Create hex to binary mapping
|
||||
Dim As String hexMap(15) = { _
|
||||
"0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", _
|
||||
"1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111" }
|
||||
|
||||
For i = 0 To Len(hexString) - 1
|
||||
hexDigit = Ucase(Mid(hexString, i + 1, 1))
|
||||
' Convert hex digit to index
|
||||
idx = Iif(hexDigit >= "0" And hexDigit <= "9", Val(hexDigit), Asc(hexDigit) - Asc("A") + 10)
|
||||
If idx >= 0 And idx <= 15 Then result &= hexMap(idx)
|
||||
Next
|
||||
Return result
|
||||
End Function
|
||||
|
||||
Sub ParseASCIIArt()
|
||||
Dim As String header = _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" | ID |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" | QDCOUNT |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" | ANCOUNT |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" | NSCOUNT |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _
|
||||
" | ARCOUNT |" & Chr(10) & _
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"
|
||||
|
||||
Dim As TableEntry fields(12) = { _
|
||||
(" ID ", 16, 0, 16), _
|
||||
(" QR ", 1, 16, 1), _
|
||||
(" Opcode ", 4, 17, 4), _
|
||||
(" AA ", 1, 21, 1), _
|
||||
(" TC ", 1, 22, 1), _
|
||||
(" RD ", 1, 23, 1), _
|
||||
(" RA ", 1, 24, 1), _
|
||||
(" Z ", 3, 25, 3), _
|
||||
(" RCODE ", 4, 28, 4), _
|
||||
("QDCOUNT ", 16, 32, 16), _
|
||||
("ANCOUNT ", 16, 48, 16), _
|
||||
("NSCOUNT ", 16, 64, 16), _
|
||||
("ARCOUNT ", 16, 80, 16) }
|
||||
|
||||
Dim As String hexStr = "78477bbf5496e12e1bf169a4"
|
||||
Dim As String binStr = HexToBinary(hexStr)
|
||||
Dim As Integer i
|
||||
|
||||
' Print header
|
||||
Print "RFC 1035 message diagram header:"
|
||||
Print header
|
||||
|
||||
' Print decoded fields
|
||||
Print !"\n Decoded:"
|
||||
Print !" Name Bits Start End\n ======= ==== ===== ==="
|
||||
|
||||
For i = 0 To 12
|
||||
Print Using " \ \ #### ##### ###"; _
|
||||
fields(i).nombre; _
|
||||
fields(i).bits; _
|
||||
fields(i).startPos; _
|
||||
fields(i).startPos + fields(i).length - 1
|
||||
Next
|
||||
|
||||
Print !"\n Test string in hex:\n " & hexStr
|
||||
Print !"\n Test string in binary:\n " & binStr
|
||||
Print !"\n Unpacked:"
|
||||
Print !" Name Size Bit Pattern\n ======= ==== ==============="
|
||||
|
||||
For i = 0 To 12
|
||||
Print Using " \ \ #### \ \"; _
|
||||
fields(i).nombre; _
|
||||
fields(i).bits; _
|
||||
Left(Mid(binStr, fields(i).startPos + 1, fields(i).length) + Space(16), 16)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
ParseASCIIArt()
|
||||
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
Structure TableEntry
|
||||
nombre.s
|
||||
bits.i
|
||||
startPos.i
|
||||
length.i
|
||||
EndStructure
|
||||
|
||||
Procedure.s HexToBinary(hexString.s)
|
||||
Dim hexMap.s(15)
|
||||
hexMap(0) = "0000" : hexMap(1) = "0001" : hexMap(2) = "0010" : hexMap(3) = "0011"
|
||||
hexMap(4) = "0100" : hexMap(5) = "0101" : hexMap(6) = "0110" : hexMap(7) = "0111"
|
||||
hexMap(8) = "1000" : hexMap(9) = "1001" : hexMap(10) = "1010" : hexMap(11) = "1011"
|
||||
hexMap(12) = "1100" : hexMap(13) = "1101" : hexMap(14) = "1110" : hexMap(15) = "1111"
|
||||
|
||||
Protected.s result = "", hexDigit
|
||||
Protected.i idx
|
||||
|
||||
For i = 0 To Len(hexString) - 1
|
||||
hexDigit = UCase(Mid(hexString, i + 1, 1))
|
||||
If hexDigit >= "0" And hexDigit <= "9"
|
||||
idx = Val(hexDigit)
|
||||
Else
|
||||
idx = Asc(hexDigit) - Asc("A") + 10
|
||||
EndIf
|
||||
If idx >= 0 And idx <= 15
|
||||
result + hexMap(idx)
|
||||
EndIf
|
||||
Next
|
||||
|
||||
ProcedureReturn result
|
||||
EndProcedure
|
||||
|
||||
Procedure ParseASCIIArt()
|
||||
Protected header.s = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" | ID |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" | QDCOUNT |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" | ANCOUNT |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" | NSCOUNT |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ +
|
||||
" | ARCOUNT |" + #CRLF$ +
|
||||
" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"
|
||||
|
||||
Dim fields.TableEntry(12)
|
||||
fields(0)\nombre = " ID " : fields(0)\bits = 16 : fields(0)\startPos = 0 : fields(0)\length = 16
|
||||
fields(1)\nombre = " QR " : fields(1)\bits = 1 : fields(1)\startPos = 16 : fields(1)\length = 1
|
||||
fields(2)\nombre = " Opcode " : fields(2)\bits = 4 : fields(2)\startPos = 17 : fields(2)\length = 4
|
||||
fields(3)\nombre = " AA " : fields(3)\bits = 1 : fields(3)\startPos = 21 : fields(3)\length = 1
|
||||
fields(4)\nombre = " TC " : fields(4)\bits = 1 : fields(4)\startPos = 22 : fields(4)\length = 1
|
||||
fields(5)\nombre = " RD " : fields(5)\bits = 1 : fields(5)\startPos = 23 : fields(5)\length = 1
|
||||
fields(6)\nombre = " RA " : fields(6)\bits = 1 : fields(6)\startPos = 24 : fields(6)\length = 1
|
||||
fields(7)\nombre = " Z " : fields(7)\bits = 3 : fields(7)\startPos = 25 : fields(7)\length = 3
|
||||
fields(8)\nombre = " RCODE " : fields(8)\bits = 4 : fields(8)\startPos = 28 : fields(8)\length = 4
|
||||
fields(9)\nombre = "QDCOUNT " : fields(9)\bits = 16 : fields(9)\startPos = 32 : fields(9)\length = 16
|
||||
fields(10)\nombre = "ANCOUNT " : fields(10)\bits = 16 : fields(10)\startPos = 48 : fields(10)\length = 16
|
||||
fields(11)\nombre = "NSCOUNT " : fields(11)\bits = 16 : fields(11)\startPos = 64 : fields(11)\length = 16
|
||||
fields(12)\nombre = "ARCOUNT " : fields(12)\bits = 16 : fields(12)\startPos = 80 : fields(12)\length = 16
|
||||
|
||||
Protected hexStr.s = "78477bbf5496e12e1bf169a4"
|
||||
Protected binStr.s = HexToBinary(hexStr)
|
||||
|
||||
PrintN("RFC 1035 message diagram header:")
|
||||
PrintN(header)
|
||||
PrintN(#CRLF$ + " Decoded:")
|
||||
PrintN(" Name Bits Start End" + #CRLF$ + " ======= ==== ===== ===")
|
||||
|
||||
For i = 0 To 12
|
||||
PrintN(RSet(fields(i)\nombre, 9) + " " + RSet(Str(fields(i)\bits), 4) + " " +
|
||||
RSet(Str(fields(i)\startPos), 6) + " " + RSet(Str(fields(i)\startPos + fields(i)\length - 1), 4))
|
||||
Next
|
||||
|
||||
PrintN(#CRLF$ + " Test string in hex:")
|
||||
PrintN(" " + hexStr)
|
||||
PrintN(#CRLF$ + " Test string in binary:")
|
||||
PrintN(" " + binStr)
|
||||
PrintN(#CRLF$ + " Unpacked:")
|
||||
PrintN(" Name Size Bit Pattern" + #CRLF$ + " ======= ==== ================")
|
||||
|
||||
For i = 0 To 12
|
||||
bitPattern.s = Mid(binStr, fields(i)\startPos + 1, fields(i)\length)
|
||||
bitPattern = Left(bitPattern + Space(16), 16)
|
||||
PrintN(RSet(fields(i)\nombre, 9) + " " + RSet(Str(fields(i)\bits), 4) + " " + bitPattern)
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
OpenConsole()
|
||||
|
||||
ParseASCIIArt()
|
||||
PrintN(#CRLF$ + "Press ENTER to exit"): Input()
|
||||
CloseConsole()
|
||||
|
|
@ -0,0 +1,95 @@
|
|||
DECLARE SUB ParseASCIIArt ()
|
||||
DECLARE FUNCTION HexToBinary$ (hexString AS STRING)
|
||||
|
||||
TYPE TableEntry
|
||||
nombre AS STRING * 8
|
||||
bits AS INTEGER
|
||||
startPos AS INTEGER
|
||||
length AS INTEGER
|
||||
END TYPE
|
||||
|
||||
ParseASCIIArt
|
||||
END
|
||||
|
||||
FUNCTION HexToBinary$ (hexString AS STRING)
|
||||
DIM hexMap(15) AS STRING
|
||||
hexMap(0) = "0000": hexMap(1) = "0001": hexMap(2) = "0010": hexMap(3) = "0011"
|
||||
hexMap(4) = "0100": hexMap(5) = "0101": hexMap(6) = "0110": hexMap(7) = "0111"
|
||||
hexMap(8) = "1000": hexMap(9) = "1001": hexMap(10) = "1010": hexMap(11) = "1011"
|
||||
hexMap(12) = "1100": hexMap(13) = "1101": hexMap(14) = "1110": hexMap(15) = "1111"
|
||||
|
||||
result$ = ""
|
||||
FOR i = 0 TO LEN(hexString) - 1
|
||||
hexDigit$ = UCASE$(MID$(hexString, i + 1, 1))
|
||||
IF hexDigit$ >= "0" AND hexDigit$ <= "9" THEN
|
||||
idx = VAL(hexDigit$)
|
||||
ELSE
|
||||
idx = ASC(hexDigit$) - ASC("A") + 10
|
||||
END IF
|
||||
IF idx >= 0 AND idx <= 15 THEN result$ = result$ + hexMap(idx)
|
||||
NEXT
|
||||
HexToBinary$ = result$
|
||||
END FUNCTION
|
||||
|
||||
SUB ParseASCIIArt
|
||||
DIM header AS STRING
|
||||
header = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " | ID |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " | QDCOUNT |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " | ANCOUNT |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " | NSCOUNT |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10)
|
||||
header = header + " | ARCOUNT |" + CHR$(10)
|
||||
header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"
|
||||
|
||||
DIM fields(12) AS TableEntry
|
||||
fields(0).nombre = " ID ": fields(0).bits = 16: fields(0).startPos = 0: fields(0).length = 16
|
||||
fields(1).nombre = " QR ": fields(1).bits = 1: fields(1).startPos = 16: fields(1).length = 1
|
||||
fields(2).nombre = " Opcode ": fields(2).bits = 4: fields(2).startPos = 17: fields(2).length = 4
|
||||
fields(3).nombre = " AA ": fields(3).bits = 1: fields(3).startPos = 21: fields(3).length = 1
|
||||
fields(4).nombre = " TC ": fields(4).bits = 1: fields(4).startPos = 22: fields(4).length = 1
|
||||
fields(5).nombre = " RD ": fields(5).bits = 1: fields(5).startPos = 23: fields(5).length = 1
|
||||
fields(6).nombre = " RA ": fields(6).bits = 1: fields(6).startPos = 24: fields(6).length = 1
|
||||
fields(7).nombre = " Z ": fields(7).bits = 3: fields(7).startPos = 25: fields(7).length = 3
|
||||
fields(8).nombre = " RCODE ": fields(8).bits = 4: fields(8).startPos = 28: fields(8).length = 4
|
||||
fields(9).nombre = "QDCOUNT ": fields(9).bits = 16: fields(9).startPos = 32: fields(9).length = 16
|
||||
fields(10).nombre = "ANCOUNT ": fields(10).bits = 16: fields(10).startPos = 48: fields(10).length = 16
|
||||
fields(11).nombre = "NSCOUNT ": fields(11).bits = 16: fields(11).startPos = 64: fields(11).length = 16
|
||||
fields(12).nombre = "ARCOUNT ": fields(12).bits = 16: fields(12).startPos = 80: fields(12).length = 16
|
||||
|
||||
hexStr$ = "78477bbf5496e12e1bf169a4"
|
||||
binStr$ = HexToBinary$(hexStr$)
|
||||
|
||||
PRINT "RFC 1035 message diagram header:"
|
||||
PRINT header
|
||||
PRINT
|
||||
PRINT " Decoded:"
|
||||
PRINT " Name Bits Start End"
|
||||
PRINT " ======= ==== ===== ==="
|
||||
|
||||
FOR i = 0 TO 12
|
||||
PRINT USING " \ \ #### ##### ###"; fields(i).nombre; fields(i).bits; fields(i).startPos; fields(i).startPos + fields(i).length - 1
|
||||
NEXT
|
||||
|
||||
PRINT
|
||||
PRINT " Test string in hex:"
|
||||
PRINT " "; hexStr$
|
||||
PRINT
|
||||
PRINT " Test string in binary:"
|
||||
PRINT " "; binStr$
|
||||
PRINT
|
||||
PRINT " Unpacked:"
|
||||
PRINT " Name Size Bit Pattern"
|
||||
PRINT " ======= ==== ==============="
|
||||
|
||||
FOR i = 0 TO 12
|
||||
bitPattern$ = MID$(binStr$, fields(i).startPos + 1, fields(i).length)
|
||||
bitPattern$ = LEFT$(bitPattern$ + SPACE$(16), 16)
|
||||
PRINT USING " \ \ #### \ \"; fields(i).nombre; fields(i).bits; bitPattern$
|
||||
NEXT
|
||||
END SUB
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
def auto_abbreviate (string)
|
||||
words = string.split
|
||||
return nil unless words.present?
|
||||
(1..words.max_of(&.size)).each do |n|
|
||||
return n if words.map(&.[0, n]).to_set.size == words.size
|
||||
end
|
||||
"∞"
|
||||
end
|
||||
|
||||
File.read_lines("weekdays.txt").each_with_index do |line, i|
|
||||
puts "#{i+1}) #{auto_abbreviate(line)} #{line}"
|
||||
end
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
Module Abbreviations_simple {
|
||||
commands=list
|
||||
a$="add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3 "
|
||||
a$+="compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate "
|
||||
a$+="3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2 "
|
||||
a$+="forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load "
|
||||
a$+="locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2 "
|
||||
a$+="msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3 "
|
||||
a$+="refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left "
|
||||
a$+="2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1"
|
||||
gosub cleanspaces
|
||||
gosub makelist
|
||||
if not empty then gosub processstack
|
||||
a$="riG rePEAT copies put mo rest types fup. 6 poweRin"
|
||||
Print a$
|
||||
gosub cleanspaces
|
||||
gosub findresult
|
||||
a$="riG macro copies macr"
|
||||
Print a$
|
||||
gosub cleanspaces
|
||||
gosub findresult
|
||||
End
|
||||
processstack:
|
||||
Read many, word$
|
||||
if many>0 and many<len(word$) then
|
||||
for i=many to len(word$)-1
|
||||
if not exist(commands, Left$(word$, i)) then
|
||||
append commands, Left$(word$, i):= word$
|
||||
else ' remove Rem to see which word has same key with other word
|
||||
Rem ? Left$(word$, i), i, word$, eval$(commands) ' same keys ??
|
||||
end if
|
||||
next
|
||||
end if
|
||||
append commands, word$
|
||||
Return
|
||||
cleanspaces:
|
||||
do
|
||||
b$=a$
|
||||
a$=replace$(" ", " ", b$)
|
||||
until b$=a$
|
||||
Return
|
||||
makelist:
|
||||
let b$="", w$="", n$=""
|
||||
flush
|
||||
for i=1 to len(A$)
|
||||
c$=mid$(a$, i, 1)
|
||||
if c$~"[a-zA-Z]" then
|
||||
if w$="" and not empty then gosub processstack
|
||||
w$+=c$
|
||||
else.if c$~"[1-9]" then
|
||||
drop : push val(c$)
|
||||
else
|
||||
if w$<>"" then data 0, ucase$(w$):w$=""
|
||||
end if
|
||||
next
|
||||
return
|
||||
findresult:
|
||||
dim a$()
|
||||
a$()=piece$(ucase$(a$), " ")
|
||||
flush
|
||||
for i=0 to len(a$())-1
|
||||
if exist(commands, a$(i)) then
|
||||
Data eval$(commands)
|
||||
else
|
||||
Data "*error*"
|
||||
end if
|
||||
next
|
||||
Print Array([])#str$(" ")
|
||||
Return
|
||||
}
|
||||
Abbreviations_simple
|
||||
|
|
@ -32,6 +32,6 @@
|
|||
(push (or found? "*error*") result -1))
|
||||
(join result " "))))
|
||||
|
||||
(foo
|
||||
(println (foo
|
||||
"riG rePEAT copies put mo rest types fup. 6 poweRin"
|
||||
)
|
||||
))
|
||||
|
|
|
|||
35
Task/Abstract-type/Arturo/abstract-type.arturo
Normal file
35
Task/Abstract-type/Arturo/abstract-type.arturo
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
define :queue [
|
||||
init: method [][
|
||||
\items: []
|
||||
]
|
||||
|
||||
enqueue: method [item][
|
||||
panic "enqueue must be implemented by concrete type"
|
||||
]
|
||||
|
||||
dequeue: method [][
|
||||
panic "dequeue must be implemented by concrete type"
|
||||
]
|
||||
]
|
||||
|
||||
define :simpleQueue is :queue [
|
||||
enqueue: method [item][
|
||||
\items: \items ++ item
|
||||
]
|
||||
|
||||
dequeue: method [][
|
||||
if empty? \items -> return null
|
||||
ret: first \items
|
||||
\items: drop \items
|
||||
return ret
|
||||
]
|
||||
]
|
||||
|
||||
q: to :simpleQueue []!
|
||||
|
||||
q\enqueue "first"
|
||||
q\enqueue "second"
|
||||
|
||||
print q\dequeue
|
||||
print q\dequeue
|
||||
print q\dequeue
|
||||
90
Task/Achilles-numbers/FutureBasic/achilles-numbers.basic
Normal file
90
Task/Achilles-numbers/FutureBasic/achilles-numbers.basic
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
NSInteger local fn GCD( n as NSInteger, d as NSInteger )
|
||||
if ( d == 0 ) then return n else return fn GCD( d, n % d )
|
||||
end fn = 0
|
||||
|
||||
NSInteger local fn Totient( n as NSInteger )
|
||||
NSInteger tot = 0
|
||||
for NSInteger m = 1 to n
|
||||
if fn GCD( m, n ) = 1 then tot++
|
||||
next
|
||||
return tot
|
||||
end fn = 0
|
||||
|
||||
BOOL local fn IsPowerful( m as NSInteger )
|
||||
int n = m
|
||||
int f = 2
|
||||
double l = sqr(m)
|
||||
|
||||
if m <= 1 then return NO
|
||||
while ( YES )
|
||||
NSInteger q = n / f
|
||||
if ( n % f ) == 0
|
||||
if ( m % (f * f) ) then return NO
|
||||
n = q
|
||||
if f > n then exit while
|
||||
else
|
||||
f++
|
||||
if ( f > l )
|
||||
if ( m % (n * n) ) then return NO
|
||||
exit while
|
||||
end if
|
||||
end if
|
||||
wend
|
||||
end fn = YES
|
||||
|
||||
BOOL local fn IsAchilles( n as NSInteger )
|
||||
if fn IsPowerful(n) == NO then return NO
|
||||
NSInteger m = 2
|
||||
NSInteger a = m * m
|
||||
do
|
||||
do
|
||||
if a == n then return NO
|
||||
a *= m
|
||||
until ( a > n )
|
||||
m++
|
||||
a = m * m
|
||||
until ( a > n )
|
||||
end fn = YES
|
||||
|
||||
local fn AchillesNumbers
|
||||
print "First 50 Achilles numbers:"
|
||||
NSInteger num = 0
|
||||
NSInteger n = 1
|
||||
|
||||
CFTimeInterval t : t = fn CACurrentMediaTime
|
||||
do
|
||||
if fn IsAchilles( n )
|
||||
printf @"%4d \b", n
|
||||
num++
|
||||
if ( num % 10 ) != 0 then printf @" \b" else print
|
||||
end if
|
||||
n++
|
||||
until ( num >= 50 )
|
||||
|
||||
printf @"\n\nFirst 20 strong Achilles numbers:"
|
||||
num = 0
|
||||
n = 1
|
||||
do
|
||||
if fn IsAchilles(n) && fn IsAchilles( fn Totient(n) )
|
||||
printf @"%5d \b", n
|
||||
num++
|
||||
if ( num % 5 ) != 0 then printf @" \b" else print
|
||||
end if
|
||||
n++
|
||||
until ( num >= 20 )
|
||||
|
||||
printf @"\n"
|
||||
for NSInteger i = 2 to 6
|
||||
NSInteger inicio = fix( 10.0 ^ (i-1) )
|
||||
num = 0
|
||||
for n = inicio to inicio * 10 -1
|
||||
if fn IsAchilles(n) then num++
|
||||
next
|
||||
printf @"Achilles numbers with %d digits: %d", i, num
|
||||
next
|
||||
printf @"\nCompute time: %.3f ms", (fn CACurrentMediaTime - t ) * 1000
|
||||
end fn
|
||||
|
||||
fn AchillesNumbers
|
||||
|
||||
HandleEvents
|
||||
8
Task/Achilles-numbers/PARI-GP/achilles-numbers.parigp
Normal file
8
Task/Achilles-numbers/PARI-GP/achilles-numbers.parigp
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
is(n,f=factor(n))=gcd(f[,2])==1 && vecmin(f[,2])>1
|
||||
first(n)=my(v=List()); forfactored(k=1,10^9, if(is(k[1],k[2]), listput(v,k[1]); if(#v==n, return(Vec(v)))))
|
||||
firstStrong(n)=my(v=List()); forfactored(k=1,10^9, if(is(k[1],k[2]) && is(eulerphi(k)), listput(v,k[1]); if(#v==n, return(Vec(v)))))
|
||||
countBetween(a,b)=my(s); forfactored(k=a,b, if(is(k[1],k[2]), s++)); s
|
||||
countDigits(n)=countBetween(10^(n-1),10^n-1)
|
||||
first(50)
|
||||
firstStrong(20)
|
||||
apply(countDigits, [2..5])
|
||||
|
|
@ -1,29 +1,29 @@
|
|||
(A) m n
|
||||
comment:
|
||||
(a) m n
|
||||
M ZERO
|
||||
(=) m 0
|
||||
(add1) n
|
||||
|
||||
(A) m n
|
||||
comment:
|
||||
(a) m n
|
||||
N ZERO
|
||||
(=) n 0
|
||||
(A) (sub1) m 1
|
||||
(a) (sub1) m 1
|
||||
|
||||
(A) m n
|
||||
comment:
|
||||
(a) m n
|
||||
DEFAULT
|
||||
#true
|
||||
(A) (sub1) m (A) m (sub1) n
|
||||
(a) (sub1) m (a) m (sub1) n
|
||||
|
||||
(add1) n
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "+" n 1
|
||||
|
||||
(sub1) n
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "-" n 1
|
||||
|
||||
(=) n1 n2
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "=" n1 n2
|
||||
|
|
|
|||
66
Task/Additive-primes/Fortran/additive-primes.f
Normal file
66
Task/Additive-primes/Fortran/additive-primes.f
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
program AdditivePrimes
|
||||
implicit none
|
||||
|
||||
integer :: i, j, digit_sum, count
|
||||
logical :: is_prime
|
||||
|
||||
! Arrays to track prime numbers and additive primes
|
||||
logical, dimension(500) :: prime_check
|
||||
logical, dimension(500) :: additive_prime_check
|
||||
|
||||
! Initialize arrays
|
||||
prime_check = .true.
|
||||
prime_check(1) = .false.
|
||||
additive_prime_check = .false.
|
||||
|
||||
! Sieve of Eratosthenes to find primes
|
||||
do i = 2, int(sqrt(real(500)))
|
||||
if (prime_check(i)) then
|
||||
do j = i*i, 500, i
|
||||
prime_check(j) = .false.
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
|
||||
! Find additive primes
|
||||
count = 0
|
||||
do i = 2, 500
|
||||
if (prime_check(i)) then
|
||||
! Calculate digit sum
|
||||
digit_sum = sum_digits(i)
|
||||
|
||||
! Check if digit sum is also prime
|
||||
if (prime_check(digit_sum)) then
|
||||
additive_prime_check(i) = .true.
|
||||
count = count + 1
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
|
||||
! Print results
|
||||
print *, "Additive Primes less than 500:"
|
||||
do i = 2, 500
|
||||
if (additive_prime_check(i)) then
|
||||
print *, i
|
||||
end if
|
||||
end do
|
||||
|
||||
print *, "Total number of additive primes:", count
|
||||
|
||||
contains
|
||||
|
||||
! Function to calculate sum of digits
|
||||
function sum_digits(num) result(total)
|
||||
integer, intent(in) :: num
|
||||
integer :: total, temp_num
|
||||
|
||||
total = 0
|
||||
temp_num = num
|
||||
|
||||
do while (temp_num > 0)
|
||||
total = total + mod(temp_num, 10)
|
||||
temp_num = temp_num / 10
|
||||
end do
|
||||
end function sum_digits
|
||||
|
||||
end program AdditivePrimes
|
||||
|
|
@ -1,15 +1,15 @@
|
|||
val isPrime = fn(i) {
|
||||
i == 2 or i > 2 and
|
||||
not any(fn x: i div x, pseries(2 .. i ^/ 2))
|
||||
not any(series(2 .. i ^/ 2, asconly=true), by=fn x:i div x)
|
||||
}
|
||||
|
||||
val sumDigits = fn i: fold(fn{+}, s2n(string(i)))
|
||||
val sumDigits = fn i: fold(s2n(string(i)), by=fn{+})
|
||||
|
||||
writeln "Additive primes less than 500:"
|
||||
|
||||
var cnt = 0
|
||||
|
||||
for i in [2] ~ series(3..500, 2) {
|
||||
for i in [2] ~ series(3..500, inc=2) {
|
||||
if isPrime(i) and isPrime(sumDigits(i)) {
|
||||
write "{{i:3}} "
|
||||
cnt += 1
|
||||
|
|
|
|||
26
Task/Additive-primes/Scala/additive-primes.scala
Normal file
26
Task/Additive-primes/Scala/additive-primes.scala
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
def isPrime(n: Int): Boolean = {
|
||||
@annotation.tailrec
|
||||
def checkDivisor(d: Int): Boolean = {
|
||||
if (d * d > n) true
|
||||
else if (n % d == 0) false
|
||||
else checkDivisor(d + 2)
|
||||
}
|
||||
|
||||
if (n < 2) false
|
||||
else if (n == 2 || n == 3) true
|
||||
else if (n % 2 == 0 || n % 3 == 0) false
|
||||
else checkDivisor(5)
|
||||
}
|
||||
|
||||
private def digitSum(n: Int): Int = n.toString.map(_ - '0').sum
|
||||
|
||||
private def additivePrime(n: Int): Boolean = isPrime(n) && isPrime(digitSum(n))
|
||||
|
||||
private def testAdditivePrime(max: Int): Unit = {
|
||||
val result = (2 to max).filter(additivePrime)
|
||||
println(result.mkString(", "))
|
||||
println(s"Found ${result.length} additive primes less than 500.")
|
||||
}
|
||||
|
||||
@main def main(): Unit =
|
||||
testAdditivePrime(500)
|
||||
|
|
@ -2,8 +2,9 @@ const std = @import("std");
|
|||
|
||||
pub fn main() !void {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
var i: i32 = undefined;
|
||||
var address_of_i: *i32 = &i;
|
||||
|
||||
try stdout.print("{x}\n", .{@intFromPtr(address_of_i)});
|
||||
const i: i32 = 76;
|
||||
try stdout.print("{x} {*}\n", .{
|
||||
@intFromPtr(&i),
|
||||
&i
|
||||
});
|
||||
}
|
||||
|
|
|
|||
212
Task/Align-columns/8080-Assembly/align-columns.8080
Normal file
212
Task/Align-columns/8080-Assembly/align-columns.8080
Normal file
|
|
@ -0,0 +1,212 @@
|
|||
putc equ 2
|
||||
puts equ 9
|
||||
fopen equ 15
|
||||
fclose equ 16
|
||||
fread equ 20
|
||||
FCB1 equ 5Ch
|
||||
FCB2 equ 6Ch
|
||||
DTA equ 80h
|
||||
COLSEP equ '$'
|
||||
org 100h
|
||||
|
||||
;;; Check arguments
|
||||
lxi d,argmsg
|
||||
lda FCB1+1 ; Check file argument
|
||||
cpi ' '
|
||||
jz prmsg
|
||||
lda FCB2+1 ; Check alignment argument
|
||||
cpi 'L'
|
||||
jz setal
|
||||
cpi 'R'
|
||||
jz setar
|
||||
cpi 'C'
|
||||
jnz prmsg
|
||||
lxi h,center ; Set alignment function to run
|
||||
jmp setfn
|
||||
setal: lxi h,left
|
||||
jmp setfn
|
||||
setar: lxi h,right
|
||||
setfn: shld alnfn+1
|
||||
|
||||
;;; Initialize column lengths to 0
|
||||
xra a
|
||||
lxi h,colw
|
||||
inicol: mov m,a
|
||||
inr l
|
||||
jnz inicol
|
||||
|
||||
;;; Open file
|
||||
lxi d,FCB1
|
||||
mvi c,fopen
|
||||
call 5
|
||||
inr a
|
||||
jz efile ; FF = error
|
||||
|
||||
;;; Process file
|
||||
lxi h,maxw ; Find maximum widths
|
||||
call rdlins
|
||||
lxi h,alnlin ; Read lines and align columns
|
||||
call rdlins
|
||||
|
||||
;;; Close file
|
||||
lxi d,FCB1
|
||||
mvi c,fclose
|
||||
jmp 5
|
||||
|
||||
;;; Update maximum widths of columns, given line
|
||||
maxw: lxi h,colw ; Column widths
|
||||
lxi d,linbuf
|
||||
mcol: mvi b,0FFh ; B = column width
|
||||
mscan: inr b
|
||||
ldax d ; Get current item
|
||||
inx d ; Next item
|
||||
call colend ; End of column?
|
||||
jc mscan
|
||||
push psw ; Keep column comparison
|
||||
mov a,m ; Current width
|
||||
cmp b ; Compare to new width
|
||||
jnc mnxcol
|
||||
mov m,b ; New one is bigger
|
||||
mnxcol: inr l ; Next column
|
||||
pop psw ; Restore column comparison
|
||||
jz mcol ; Keep going if not end of line
|
||||
ret
|
||||
|
||||
;;; Align and print columns of line
|
||||
alnlin: lxi h,colw
|
||||
lxi b,linbuf
|
||||
alncol: lxi d,colbuf-1
|
||||
alnscn: inx d ; Copy current column to buffer
|
||||
ldax b
|
||||
stax d
|
||||
inx b
|
||||
call colend
|
||||
jc alnscn
|
||||
push psw
|
||||
push h
|
||||
push b
|
||||
alncal: xra a ; Zero-terminate the buffer
|
||||
stax d
|
||||
mov a,m ; Current max column length
|
||||
sub e ; Minus length of this column
|
||||
mov b,a ; Set B = current padding needed
|
||||
alnfn: call 0 ; Call selected alignment
|
||||
pop b
|
||||
pop h
|
||||
inr l
|
||||
pop psw
|
||||
jz alncol ; Next column, if any
|
||||
lxi d,newlin ; End line
|
||||
mvi c,puts
|
||||
jmp 5
|
||||
|
||||
;;; Align column left and print
|
||||
left: push b ; Save padding needed
|
||||
lxi h,colbuf ; Print column
|
||||
call print0
|
||||
pop b ; Restore padding
|
||||
inr b ; Plus one, for separator between columns
|
||||
|
||||
;;; Print B spaces as padding
|
||||
pad: xra a
|
||||
ora b
|
||||
rz ; No padding
|
||||
padl: push b
|
||||
mvi e,' '
|
||||
mvi c,putc
|
||||
call 5
|
||||
pop b
|
||||
dcr b
|
||||
jnz padl
|
||||
ret
|
||||
|
||||
;;; Align column right and print
|
||||
right: call pad ; Padding first
|
||||
lxi h,colbuf
|
||||
call print0 ; Then column
|
||||
mvi b,1
|
||||
jmp pad ; Separator space
|
||||
|
||||
;;; Align column in the center and print
|
||||
center: mov a,b ; Split padding in half
|
||||
rar
|
||||
mov b,a
|
||||
aci 0
|
||||
mov c,a
|
||||
push b ; Keep both parts
|
||||
call pad ; Left padding
|
||||
lxi h,colbuf ; Print column
|
||||
call print0
|
||||
pop b ; Restore padding
|
||||
mov b,c ; Right padding
|
||||
inr b ; Plus one for the separator
|
||||
jmp pad
|
||||
|
||||
;;; Print 0-terminated string at HL
|
||||
print0: mov a,m
|
||||
ana a
|
||||
rz
|
||||
push h
|
||||
mov e,m
|
||||
mvi c,putc
|
||||
call 5
|
||||
pop h
|
||||
inx h
|
||||
jmp print0
|
||||
|
||||
;;; Does character in A end a column?
|
||||
;;; C clear if so. Z clear if also end of line.
|
||||
colend: cpi 32 ; End of line?
|
||||
cmc
|
||||
rnc
|
||||
cpi COLSEP ; Separator?
|
||||
rz
|
||||
stc ; If neither, set carry and return
|
||||
ret
|
||||
|
||||
;;; Process file in FCB1 line by line
|
||||
;;; HL = line callback
|
||||
rdlins: shld linecb+1 ; Set callback
|
||||
xra a ; Start at beginning of file
|
||||
sta FCB1+0Ch ; EX
|
||||
sta FCB1+0Eh ; S2
|
||||
sta FCB1+0Fh ; RC
|
||||
sta FCB1+20h ; AL
|
||||
lxi d,linbuf ; Start write pointer at line buffer
|
||||
rdrec: push d ; Keep write pointer
|
||||
lxi d,FCB1 ; Read next record
|
||||
mvi c,fread
|
||||
call 5
|
||||
pop d ; Restore write pointer
|
||||
dcr a ; 1 = EOF
|
||||
rz
|
||||
inr a
|
||||
jnz efile ; Otherwise, <>0 = error
|
||||
lxi h,DTA ; Reset read pointer to DTA
|
||||
cpydat: mov a,m ; Copy byte to line buffer
|
||||
stax d
|
||||
inx d
|
||||
cpi 26 ; EOF -> done
|
||||
rz
|
||||
cpi 10 ; (\r)\n -> EOL
|
||||
jnz cnexb
|
||||
push h ; Keep record pointer
|
||||
linecb: call 0 ; Call callback routine
|
||||
pop h ; Restore record pointer
|
||||
lxi d,linbuf ; Reset line pointer
|
||||
cnexb: inr l ; Next byte
|
||||
jz rdrec ; Next record
|
||||
jmp cpydat
|
||||
efile: lxi d,filerr
|
||||
prmsg: mvi c,puts
|
||||
jmp 5
|
||||
|
||||
;;; Messages
|
||||
argmsg: db 'ALIGN FILE.TXT L/R/C$'
|
||||
filerr: db 'FILE ERROR$'
|
||||
newlin: db 13,10,'$'
|
||||
|
||||
;;; Variables
|
||||
colw equ ($/256+1)*256 ; Column widths (page-aligned)
|
||||
colbuf equ colw+256 ; Column buffer
|
||||
linbuf equ colbuf+256 ; Line buffer
|
||||
134
Task/Align-columns/Cowgol/align-columns.cowgol
Normal file
134
Task/Align-columns/Cowgol/align-columns.cowgol
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
include "cowgol.coh";
|
||||
include "strings.coh";
|
||||
include "file.coh";
|
||||
include "argv.coh";
|
||||
|
||||
interface ColumnCb(colnum: uint8, col: [uint8], isLast: uint8);
|
||||
sub ForEachColumn(fcb: [FCB], colfn: ColumnCb, colsep: uint8) is
|
||||
var linebuf: uint8[256];
|
||||
var bufptr := &linebuf[0];
|
||||
|
||||
sub HandleColumns() is
|
||||
var colbuf: uint8[256];
|
||||
var col: uint8 := 0;
|
||||
var lineptr := &linebuf[0];
|
||||
var colptr := &colbuf[0];
|
||||
|
||||
while [lineptr] != 0 loop
|
||||
if [lineptr] == colsep or [lineptr] == '\n' then
|
||||
[colptr] := 0;
|
||||
colptr := &colbuf[0];
|
||||
if [lineptr] == '\n' then
|
||||
colfn(col, colptr, 1);
|
||||
else
|
||||
colfn(col, colptr, 0);
|
||||
end if;
|
||||
col := col + 1;
|
||||
else
|
||||
[colptr] := [lineptr];
|
||||
colptr := @next colptr;
|
||||
end if;
|
||||
lineptr := @next lineptr;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
var len := FCBExt(fcb);
|
||||
FCBSeek(fcb, 0);
|
||||
|
||||
while len > 0 loop
|
||||
var ch := FCBGetChar(fcb);
|
||||
[bufptr] := ch;
|
||||
bufptr := @next bufptr;
|
||||
len := len - 1;
|
||||
|
||||
if ch == '\n' then
|
||||
[bufptr] := 0;
|
||||
HandleColumns();
|
||||
bufptr := &linebuf[0];
|
||||
end if;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
var columnWidths: uint8[256];
|
||||
sub FindColumnMaxWidths(fcb: [FCB], colsep: uint8) is
|
||||
sub FindColumnMaxWidth implements ColumnCb is
|
||||
var len := StrLen(col) as uint8;
|
||||
if columnWidths[colnum] < len then
|
||||
columnWidths[colnum] := len;
|
||||
end if;
|
||||
end sub;
|
||||
|
||||
ForEachColumn(fcb, FindColumnMaxWidth, colsep);
|
||||
end sub;
|
||||
|
||||
sub Pad(padding: uint8) is
|
||||
while padding > 0 loop
|
||||
print_char(' ');
|
||||
padding := padding - 1;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
interface Alignment(padding: uint8, string: [uint8]);
|
||||
sub Left implements Alignment is
|
||||
print(string);
|
||||
Pad(padding);
|
||||
end sub;
|
||||
|
||||
sub Right implements Alignment is
|
||||
Pad(padding);
|
||||
print(string);
|
||||
end sub;
|
||||
|
||||
sub Center implements Alignment is
|
||||
Pad(padding >> 1);
|
||||
print(string);
|
||||
Pad((padding >> 1) + (padding & 1));
|
||||
end sub;
|
||||
|
||||
sub PrintColumnsAligned(fcb: [FCB], colsep: uint8, alignment: Alignment) is
|
||||
sub PrintColumnAligned implements ColumnCb is
|
||||
var len := StrLen(col) as uint8;
|
||||
var padding := columnWidths[colnum] - len;
|
||||
alignment(padding, col);
|
||||
if isLast != 0 then
|
||||
print_nl();
|
||||
else
|
||||
print_char(' ');
|
||||
end if;
|
||||
end sub;
|
||||
|
||||
ForEachColumn(fcb, PrintColumnAligned, colsep);
|
||||
end sub;
|
||||
|
||||
ArgvInit();
|
||||
var filename := ArgvNext();
|
||||
if filename == 0 as [uint8] then
|
||||
print("No filename given\n");
|
||||
ExitWithError();
|
||||
end if;
|
||||
|
||||
var align := ArgvNext();
|
||||
if align == 0 as [uint8] then
|
||||
print("No alignment given\n");
|
||||
ExitWithError();
|
||||
end if;
|
||||
|
||||
var alignment: Alignment;
|
||||
case [align] & ~32 is
|
||||
when 'L': alignment := Left;
|
||||
when 'R': alignment := Right;
|
||||
when 'C': alignment := Center;
|
||||
when else:
|
||||
print("Alignment must be L(eft), R(ight), or C(enter)\n");
|
||||
ExitWithError();
|
||||
end case;
|
||||
|
||||
var file: FCB;
|
||||
if FCBOpenIn(&file, filename) != 0 then
|
||||
print("Cannot open file\n");
|
||||
ExitWithError();
|
||||
end if;
|
||||
|
||||
const separator := '$';
|
||||
FindColumnMaxWidths(&file, separator);
|
||||
PrintColumnsAligned(&file, separator, alignment);
|
||||
93
Task/Align-columns/Draco/align-columns.draco
Normal file
93
Task/Align-columns/Draco/align-columns.draco
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
\util.g
|
||||
char separator = '$';
|
||||
|
||||
type
|
||||
colHandler = proc(byte n; *char col; bool last)void,
|
||||
alignment = proc(byte padding; *char col)void;
|
||||
|
||||
[256]byte ColWidths;
|
||||
alignment Alignment;
|
||||
|
||||
proc find_max_col_width(byte n; *char col; bool last) void:
|
||||
if ColWidths[n] < CharsLen(col) then
|
||||
ColWidths[n] := CharsLen(col)
|
||||
fi
|
||||
corp
|
||||
|
||||
proc write_col_aligned(byte n; *char col; bool last) void:
|
||||
byte padding;
|
||||
padding := ColWidths[n] - CharsLen(col);
|
||||
Alignment(padding, col);
|
||||
if last then writeln() else write(' ') fi
|
||||
corp
|
||||
|
||||
proc pad(byte padding) void:
|
||||
while padding>0 do write(' '); padding := padding-1 od
|
||||
corp
|
||||
|
||||
proc align_left(byte padding; *char col) void: write(col); pad(padding) corp
|
||||
proc align_right(byte padding; *char col) void: pad(padding); write(col) corp
|
||||
proc align_center(byte padding; *char col) void:
|
||||
pad(padding>>1);
|
||||
write(col);
|
||||
pad((padding>>1) + (padding&1))
|
||||
corp
|
||||
|
||||
proc do_line(*char line; colHandler handler) void:
|
||||
byte col;
|
||||
bool last;
|
||||
char ch;
|
||||
*char colstart;
|
||||
col := 0;
|
||||
colstart := line;
|
||||
|
||||
while
|
||||
ch := line*;
|
||||
last := ch = '\e';
|
||||
if last or ch = separator then
|
||||
line* := '\e';
|
||||
handler(col, colstart, last);
|
||||
colstart := line+1;
|
||||
col := col+1
|
||||
fi;
|
||||
not last
|
||||
do
|
||||
line := line+1
|
||||
od
|
||||
corp
|
||||
|
||||
proc do_columns(*char filename; colHandler handler) void:
|
||||
[256]char linebuf;
|
||||
*char line;
|
||||
channel input text in;
|
||||
file(1024) infile;
|
||||
|
||||
open(in, infile, filename);
|
||||
line := &linebuf[0];
|
||||
while readln(in; line) do do_line(line, handler) od;
|
||||
close(in);
|
||||
corp
|
||||
|
||||
proc ucase(char c) char: pretend(pretend(c, byte) & ~32, char) corp
|
||||
|
||||
proc main() void:
|
||||
*char filename, align;
|
||||
word i;
|
||||
for i from 0 upto 255 do ColWidths[i] := 0 od;
|
||||
|
||||
filename := GetPar();
|
||||
if filename = nil then writeln("No filename given"); exit(1) fi;
|
||||
|
||||
align := GetPar();
|
||||
if align = nil then writeln("No alignment given"); exit(1) fi;
|
||||
|
||||
case ucase(align*)
|
||||
incase 'L': Alignment := align_left
|
||||
incase 'R': Alignment := align_right
|
||||
incase 'C': Alignment := align_center
|
||||
default: writeln("Alignment must be L/R/C"); exit(1)
|
||||
esac;
|
||||
|
||||
do_columns(filename, find_max_col_width);
|
||||
do_columns(filename, write_col_aligned)
|
||||
corp
|
||||
251
Task/Align-columns/Emacs-Lisp/align-columns.l
Normal file
251
Task/Align-columns/Emacs-Lisp/align-columns.l
Normal file
|
|
@ -0,0 +1,251 @@
|
|||
(defun rob-even-p (integer)
|
||||
"Test if INTEGER is even."
|
||||
(= (% integer 2) 0))
|
||||
|
||||
(defun rob-odd-p (integer)
|
||||
"Test if INTEGER is odd."
|
||||
(not (rob-even-p integer)))
|
||||
|
||||
(defun both-odd-or-both-even-p (x y)
|
||||
"Test if X and Y are both even or both odd."
|
||||
(or (and (rob-even-p x) (rob-even-p y))
|
||||
(and (rob-odd-p x) (rob-odd-p y))))
|
||||
|
||||
(defun word-lengths (words)
|
||||
"Convert WORDS into list of lengths of each word."
|
||||
(mapcar 'length words))
|
||||
|
||||
(defun get-one-row (row-number rows-columns-words)
|
||||
"Get ROW-NUMBER row from ROWS-COLUMNS-WORDS.
|
||||
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
|
||||
(seq-filter
|
||||
(lambda (element)
|
||||
(= row-number (car element)))
|
||||
rows-columns-words))
|
||||
|
||||
(defun get-one-word (row-number column-number rows-columns-words)
|
||||
"Get one word from ROWS-COLUMNS-WORDS at ROW-NUMBER and COLUMN-NUMBER.
|
||||
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (element)
|
||||
(when (= column-number (nth 1 element))
|
||||
(nth 2 element)))
|
||||
(get-one-row row-number rows-columns-words))))
|
||||
|
||||
(defun get-last-row (rows-columns-words)
|
||||
"Get the number of the last row of ROWS-COLUMNS-WORDS.
|
||||
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of
|
||||
row, column, word."
|
||||
(apply 'max (mapcar 'car rows-columns-words)))
|
||||
|
||||
(defun list-nth-column (column rows-columns-words)
|
||||
"List the words in column COLUMN of ROWS-COLUMNS-WORDS.
|
||||
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of row, column,
|
||||
word."
|
||||
(let ((row 1)
|
||||
(column-word)
|
||||
(last-row (get-last-row rows-columns-words ))
|
||||
(matches nil))
|
||||
(while (and (<= row last-row)
|
||||
(<= column (get-last-column rows-columns-words)))
|
||||
(setq column-word (get-one-word row column rows-columns-words))
|
||||
(when (null column-word)
|
||||
(setq column-word ""))
|
||||
(push column-word matches)
|
||||
(setq row (1+ row)))
|
||||
(flatten-tree (nreverse matches))))
|
||||
|
||||
(defun get-widest-in-column (column)
|
||||
"Get the widest word in COLUMN, which is a list of words."
|
||||
(apply #'max (word-lengths column)))
|
||||
|
||||
(defun get-column-width (column)
|
||||
"Calculate the width of COLUMN, which is a list of words."
|
||||
(+ (get-widest-in-column column) 2))
|
||||
|
||||
(defun get-column-widths (rows-columns-words)
|
||||
"Make a list of the column widths in ROWS-COLUMNS-WORDS.
|
||||
ROWS-COLUMNS-WORDS is list of lists, with each list in the form of row, column,
|
||||
word."
|
||||
(let ((last-column (get-last-column rows-columns-words))
|
||||
(column 1)
|
||||
(columns))
|
||||
(while (<= column last-column)
|
||||
(push (get-column-width (list-nth-column column rows-columns-words)) columns)
|
||||
(setq column (1+ column)))
|
||||
(reverse columns)))
|
||||
|
||||
(defun add-column-widths (widths rows-columns-words)
|
||||
"Add WIDTHS to ROWS-COLUMNS-WORDS.
|
||||
ROWS-COLUMNS-WORDS is a list of lists, with each list in the form of row,
|
||||
column, word. WIDTHS are the widths of each column. Output is a
|
||||
list of lists, with each list in the form of column-width, row,
|
||||
column, word."
|
||||
(let ((new-data)
|
||||
(new-database)
|
||||
(column)
|
||||
(width))
|
||||
(dolist (data rows-columns-words)
|
||||
(setq column (cadr data))
|
||||
(setq width (nth (- column 1) widths))
|
||||
(setq new-data (push width data))
|
||||
(push new-data new-database))
|
||||
(nreverse new-database)))
|
||||
|
||||
(defun get-last-column (rows-columns-words)
|
||||
"Get the number of the last column in ROWS-COLUMNS-WORDS."
|
||||
(apply 'max (mapcar 'cadr rows-columns-words)))
|
||||
|
||||
(defun create-rows-columns-words ()
|
||||
"Put text from column-data.txt file in lists.
|
||||
Each list consists of a row number, a column number, and a word."
|
||||
(let ((lines)
|
||||
(line-number 0)
|
||||
(word-number)
|
||||
(words))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents "~/Documents/Elisp/column_data.txt")
|
||||
(beginning-of-buffer)
|
||||
(dolist (line (split-string (buffer-string) "[\r\n]" :no-nulls))
|
||||
(push line lines))
|
||||
(setq lines (nreverse lines)))
|
||||
(dolist (line lines)
|
||||
(setq line-number (1+ line-number))
|
||||
(setq word-number 0)
|
||||
(dolist (word (split-string line "\\$" :no-nulls))
|
||||
(setq word-number (1+ word-number))
|
||||
(push (list line-number word-number word) words)))
|
||||
(setq words (nreverse words))))
|
||||
|
||||
(defun pad-for-center-align (column-width text)
|
||||
"Pad TEXT to center in space of COLUMN-WIDTH."
|
||||
(let* ((text-width (length text))
|
||||
(total-padding-length (- column-width text-width))
|
||||
(pre-padding-length)
|
||||
(post-padding-length)
|
||||
(pre-padding)
|
||||
(post-padding))
|
||||
(if (both-odd-or-both-even-p text-width column-width)
|
||||
(progn
|
||||
(setq pre-padding-length (/ total-padding-length 2))
|
||||
(setq post-padding-length pre-padding-length))
|
||||
(setq pre-padding-length (+ (/ total-padding-length 2) 1))
|
||||
(setq post-padding-length (- pre-padding-length 1)))
|
||||
(setq pre-padding (make-string pre-padding-length ? ))
|
||||
(setq post-padding (make-string post-padding-length ? ))
|
||||
(format "%s%s%s" pre-padding text post-padding)))
|
||||
|
||||
(defun create-a-center-aligned-line (widths-1row-columns-words)
|
||||
"Create a centered line based on WIDTHS-1ROW-COLUMNS-WORDS.
|
||||
WIDTHS-1ROW-COLUMNS-WORDS is a list of lists. Each list consists
|
||||
of the column-width, the row number, the column number, and the
|
||||
word. The row number is the same in all lists."
|
||||
(let ((full-line "")
|
||||
(next-section))
|
||||
(insert "\n")
|
||||
(dolist (word-data widths-1row-columns-words)
|
||||
;; below, nth 0 is the column width, nth 3 is the word
|
||||
(setq next-section (pad-for-center-align (nth 0 word-data) (nth 3 word-data)))
|
||||
(setq full-line (concat full-line next-section)))
|
||||
(insert full-line)))
|
||||
|
||||
(defun pad-for-left-align (column-width text)
|
||||
"Pad TEXT to left-align in space of COLUMN-WIDTH."
|
||||
(let* ((text-width (length text))
|
||||
(post-padding-length (- column-width text-width)))
|
||||
(setq post-padding (make-string post-padding-length ? ))
|
||||
(format "%s%s" text post-padding)))
|
||||
|
||||
(defun create-a-left-aligned-line (widths-1row-columns-words)
|
||||
"Create a left-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
|
||||
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
|
||||
width, the row number, the column number, and the word. The row
|
||||
number is the same in every case."
|
||||
(let ((full-line "")
|
||||
(next-section))
|
||||
(insert "\n")
|
||||
(dolist (one-item widths-1row-columns-words)
|
||||
(setq next-section (pad-for-left-align (nth 0 one-item) (nth 3 one-item)))
|
||||
(setq full-line (concat full-line next-section)))
|
||||
(insert full-line)))
|
||||
|
||||
(defun pad-for-right-align (column-width text)
|
||||
"Pad TEXT to right-align in space of COLUMN-WIDTH."
|
||||
(let* ((text-width (length text))
|
||||
(pre-padding-length (- column-width text-width)))
|
||||
(setq pre-padding (make-string pre-padding-length ? ))
|
||||
(format "%s%s" pre-padding text)))
|
||||
|
||||
(defun create-a-right-aligned-line (widths-1row-columns-words)
|
||||
"Create a right-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
|
||||
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
|
||||
width, the row number, the column number, and the word. The row
|
||||
number is the same in every case."
|
||||
(let ((full-line "")
|
||||
(next-section))
|
||||
(insert "\n")
|
||||
(dolist (one-item widths-1row-columns-words)
|
||||
(setq next-section (pad-for-right-align (nth 0 one-item) (nth 3 one-item)))
|
||||
(setq full-line (concat full-line next-section)))
|
||||
(insert full-line)))
|
||||
|
||||
(defun left-align-lines (rows-columns-words)
|
||||
"Write ROWS-COLUMNS-WORDS in left-aligned columns.
|
||||
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
|
||||
row number, the column number, and the word."
|
||||
(let* ((row-number 1)
|
||||
(column-widths (get-column-widths rows-columns-words))
|
||||
(last-row (get-last-row rows-columns-words))
|
||||
(one-row)
|
||||
(width-place 0))
|
||||
(while (<= row-number last-row)
|
||||
(setq one-row (get-one-row row-number rows-columns-words))
|
||||
(setq one-row (add-column-widths column-widths one-row))
|
||||
(create-a-left-aligned-line one-row)
|
||||
(setq row-number (1+ row-number))
|
||||
(setq width-place (1+ width-place)))))
|
||||
|
||||
(defun right-align-lines (rows-columns-words)
|
||||
"Write ROWS-COLUMNS-WORDS in right-aligned columns.
|
||||
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
|
||||
row number, the column number, and the word."
|
||||
(let* ((row-number 1)
|
||||
(column-widths (get-column-widths rows-columns-words))
|
||||
(last-row (get-last-row rows-columns-words))
|
||||
(one-row)
|
||||
(width-place 0))
|
||||
(while (<= row-number last-row)
|
||||
(setq one-row (get-one-row row-number rows-columns-words))
|
||||
(setq one-row (add-column-widths column-widths one-row))
|
||||
(create-a-right-aligned-line one-row)
|
||||
(setq row-number (1+ row-number))
|
||||
(setq width-place (1+ width-place)))))
|
||||
|
||||
(defun center-align-lines (rows-columns-words)
|
||||
"Write ROWS-COLUMNS-WORDS in center-aligned columns.
|
||||
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
|
||||
row number, the column number, and the word."
|
||||
(let* ((row-number 1)
|
||||
(column-widths (get-column-widths rows-columns-words))
|
||||
(last-row (get-last-row rows-columns-words))
|
||||
(one-row)
|
||||
(width-place 0))
|
||||
(while (<= row-number last-row)
|
||||
(setq one-row (get-one-row row-number rows-columns-words))
|
||||
(setq one-row (add-column-widths column-widths one-row))
|
||||
(create-a-center-aligned-line one-row)
|
||||
(setq row-number (1+ row-number))
|
||||
(setq width-place (1+ width-place)))))
|
||||
|
||||
(defun align-lines (alignment rows-columns-words)
|
||||
"Write ROWS-COLUMNS-WIDTHS with given ALIGNMENT.
|
||||
ROWS-COLUMNS-WIDTHS consists of a list of lists. Each internal list contains width of column, row number, column number, and a word."
|
||||
(let ((align-function (pcase alignment
|
||||
('left 'left-align-lines)
|
||||
("left" 'left-align-lines)
|
||||
('center 'center-align-lines)
|
||||
("center" 'center-align-lines)
|
||||
('right 'right-align-lines)
|
||||
("right" 'right-align-lines))))
|
||||
(funcall align-function rows-columns-words)))
|
||||
34
Task/Align-columns/Miranda/align-columns.miranda
Normal file
34
Task/Align-columns/Miranda/align-columns.miranda
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
#! /usr/bin/mira -exec
|
||||
main :: [sys_message]
|
||||
main = [Stdout (align (alignment algm) '$' (read file))]
|
||||
where [cmd, file, algm] = $*
|
||||
|
||||
alignment :: [char]->num->[char]->[char]
|
||||
alignment "left" = ljustify
|
||||
alignment "center" = cjustify
|
||||
alignment "right" = rjustify
|
||||
alignment x = error "Alignment must be left, center, or right"
|
||||
|
||||
align :: (num->[char]->[char])->char->[char]->[char]
|
||||
align just sep text = (lay . map (alignline just sep cols) . lines) text
|
||||
where cols = colwidths sep text
|
||||
|
||||
split :: *->[*]->[[*]]
|
||||
split sep = s []
|
||||
where s acc [] = [acc]
|
||||
s acc (a:as) = acc:s [] as, if a==sep
|
||||
= s (acc++[a]) as, otherwise
|
||||
|
||||
colwidths :: char->[char]->[num]
|
||||
colwidths sep text = (map max . transpose . map (extend maxwidth 0)) widths
|
||||
where widths = map (map (#) . split sep) (lines text)
|
||||
maxwidth = max (map (#) widths)
|
||||
|
||||
alignline :: (num->[char]->[char])->char->[num]->[char]->[char]
|
||||
alignline just sep cols = concat . map (++" ") . zipwith just cols . split sep
|
||||
|
||||
zipwith :: (*->**->***)->[*]->[**]->[***]
|
||||
zipwith f xs ys = map f' (zip2 xs ys) where f' (x,y) = f x y
|
||||
|
||||
extend :: num->*->[*]->[*]
|
||||
extend n k ls = ls ++ take (n-#ls) (repeat k)
|
||||
71
Task/Align-columns/Refal/align-columns.refal
Normal file
71
Task/Align-columns/Refal/align-columns.refal
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
$ENTRY Go {
|
||||
, <Arg 1>: e.File
|
||||
, <Arg 2>: e.Alignment
|
||||
, <ReadFile 1 e.File>: e.Lines
|
||||
, <Each (Split ('$')) e.Lines>: e.Parts
|
||||
, <Each (MaxWidth) <Transpose e.Parts>>: e.Cols
|
||||
= <Each (AlignLine (e.Alignment) (e.Cols)) e.Parts>;
|
||||
};
|
||||
|
||||
ReadFile {
|
||||
s.Chan e.File = <Open 'r' s.Chan e.File>
|
||||
<ReadFile (s.Chan)>;
|
||||
(s.Chan), <Get s.Chan>: {
|
||||
0 = <Close s.Chan>;
|
||||
e.Line = (e.Line) <ReadFile (s.Chan)>;
|
||||
};
|
||||
};
|
||||
|
||||
Split {
|
||||
(e.Sep) e.Part e.Sep e.Rest = (e.Part) <Split (e.Sep) e.Rest>;
|
||||
(e.Sep) e.Part = (e.Part);
|
||||
};
|
||||
|
||||
Each {
|
||||
(e.F) = ;
|
||||
(e.F) (e.X) e.Xs = (<Mu e.F e.X>) <Each (e.F) e.Xs>;
|
||||
};
|
||||
|
||||
MaxWidth {
|
||||
(Acc s.W) = s.W;
|
||||
(Acc s.W) (e.P) e.X, <Len e.P>: s.L, <Compare s.L s.W>: {
|
||||
'+' = <MaxWidth (Acc s.L) e.X>;
|
||||
s.C = <MaxWidth (Acc s.W) e.X>;
|
||||
};
|
||||
e.X = <MaxWidth (Acc 0) e.X>;
|
||||
};
|
||||
|
||||
Transpose {
|
||||
e.X, <Each (Head) e.X>: e.L, <Empty e.L>: {
|
||||
True = ;
|
||||
False = (e.L) <Transpose <Each (Tail) e.X>>;
|
||||
};
|
||||
};
|
||||
|
||||
ZipWith {
|
||||
(e.F) () e.Ys = ;
|
||||
(e.F) e.Xs () = ;
|
||||
(e.F) (t.X e.Xs) (t.Y e.Ys) = <Mu e.F t.X t.Y> <ZipWith (e.F) (e.Xs) (e.Ys)>;
|
||||
};
|
||||
|
||||
AlignCell {
|
||||
('left') (e.Cell) (s.Width),
|
||||
<Len e.Cell>: s.L = e.Cell <Rep <Sub s.Width s.L> ' '> ' ';
|
||||
('right') (e.Cell) (s.Width),
|
||||
<Len e.Cell>: s.L = <Rep <Sub s.Width s.L> ' '> e.Cell ' ';
|
||||
('center') (e.Cell) (s.Width),
|
||||
<Divmod <Sub s.Width <Len e.Cell>> 2>: (s.P) s.V,
|
||||
<Rep s.P ' '>: e.LP,
|
||||
<Rep <Add s.P s.V> ' '>: e.RP = e.LP e.Cell e.RP ' ';
|
||||
};
|
||||
|
||||
AlignLine {
|
||||
(e.Alignment) (e.Cols) e.Line =
|
||||
<Prout <ZipWith (AlignCell (e.Alignment)) (e.Line) (e.Cols)>>;
|
||||
};
|
||||
|
||||
Rep { 0 s.C = ; s.N s.C = s.C <Rep <Sub s.N 1> s.C>; };
|
||||
Empty { = True; () e.X = <Empty e.X>; e.X = False; };
|
||||
Len { e.X, <Lenw e.X>: s.L e.X = s.L; };
|
||||
Head { = ; (e.X) e.Xs = e.X; };
|
||||
Tail { = ; (e.X) e.Xs = e.Xs; };
|
||||
|
|
@ -0,0 +1,95 @@
|
|||
begin globals
|
||||
short n
|
||||
long arr(17)
|
||||
bool gStop = _False
|
||||
end globals
|
||||
|
||||
local fn sumFactors(nx as long) as long
|
||||
long i, sumFactor
|
||||
sumFactor = 0
|
||||
for i = 1 to fix(nx / 2)
|
||||
if (nx) mod i = 0 then sumFactor = sumFactor + i
|
||||
next
|
||||
end fn = sumFactor
|
||||
|
||||
void local fn printSeries(arrx as short, size as short, type as str255)
|
||||
short i = 0
|
||||
print
|
||||
print "Integer" + str$(arrx) + ", Type: " + type + ", Series: ";
|
||||
for i=0 to size - 2
|
||||
print str$(arr(i)) + " ";
|
||||
next i
|
||||
end fn
|
||||
|
||||
local fn Aliquot(nx as long)
|
||||
|
||||
short i, j
|
||||
str255 type
|
||||
|
||||
type = "Sociable"
|
||||
arr(0) = nx
|
||||
|
||||
for i = 1 to 15
|
||||
|
||||
arr(i) = fn sumFactors(arr(i-1))
|
||||
if (arr(i)=0 || arr(i)=nx || (arr(i) = arr(i-1)) && arr(i)<>nx)
|
||||
if arr(i) = 0
|
||||
type = "Terminating"
|
||||
else
|
||||
if arr(i) = nx && i = 1
|
||||
type = "Perfect"
|
||||
else
|
||||
if arr(i) = nx && i = 2
|
||||
type = "Amicable"
|
||||
else
|
||||
if arr(i) = arr(i-1) && arr(i)<>nx
|
||||
type = "Aspiring"
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
|
||||
fn printSeries(arr(0),i+1,type)
|
||||
if type = "Terminating"
|
||||
print " 0"
|
||||
else
|
||||
print
|
||||
end if
|
||||
|
||||
exit fn
|
||||
end if
|
||||
|
||||
|
||||
for j = 1 to i-1
|
||||
if arr(j) = arr(i)
|
||||
fn printSeries(arr(0),i+1,"Cyclic")
|
||||
print
|
||||
exit fn
|
||||
end if
|
||||
next j
|
||||
next i
|
||||
fn printSeries(arr(i),i+1,"Non-Terminating")
|
||||
print
|
||||
|
||||
end fn
|
||||
|
||||
|
||||
local fn DoAliquot
|
||||
// declare and assign c-type array
|
||||
long dataArray(30) = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184,¬
|
||||
12496, 1264460, 790, 909, 562, 1064, 1488, 0}
|
||||
|
||||
short i
|
||||
for i = 0 to 24
|
||||
if dataArray(i) = 0 then gStop = _True:exit fn
|
||||
fn Aliquot(dataArray(i))
|
||||
next i
|
||||
|
||||
end fn = gStop
|
||||
|
||||
window 1,@"Aliquot sequence classifications",fn CGRectMake(0, 0, 1150, 700)
|
||||
windowcenter(1)
|
||||
|
||||
fn AppSetTimer( .000001, @Fn DoAliquot, _true )
|
||||
|
||||
handleevents
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
\p77
|
||||
sqrt(375/4/suminf(n=0,(6*n)!*(532*n^2+126*n+9.)/(n!*10^n)^6))
|
||||
|
|
@ -10,6 +10,6 @@ val alljoin = fn words: for[=true] i of len(words)-1 {
|
|||
}
|
||||
|
||||
# amb expects 2 or more arguments
|
||||
val amb = fn ...[2..] words: if alljoin(words) { join " ", words }
|
||||
val amb = fn ...[2..] words: if alljoin(words) { join words, by=" " }
|
||||
|
||||
writeln join("\n", filter(mapX(amb, wordsets...)))
|
||||
writeln join(mapX(wordsets..., by=amb) -> filter, by="\n")
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
(LAMBDA (K-SUCCESS) ; which we return possibles.
|
||||
(CALL-WITH-CURRENT-CONTINUATION
|
||||
(LAMBDA (K-FAILURE) ; K-FAILURE will try the next
|
||||
(SET! FAIL K-FAILURE) ; possible expression.
|
||||
(SET! FAIL (LAMBDA () (K-FAILURE 'anything-is-fine-here))) ; possible expression.
|
||||
(K-SUCCESS ; Note that the expression is
|
||||
(LAMBDA () ; evaluated in tail position
|
||||
expression)))) ; with respect to AMB.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,33 @@
|
|||
100 REM Angle difference between two bearings
|
||||
110 DECLARE EXTERNAL FUNCTION GetDiff
|
||||
120 REM
|
||||
130 SUB PrintRow(B1, B2)
|
||||
140 PRINT USING "#######.###### #######.###### #######.######": B1, B2, GetDiff(B1, B2)
|
||||
150 END SUB
|
||||
160 REM
|
||||
170 print "Input in -180 to +180 range"
|
||||
180 PRINT " Bearing 1 Bearing 2 Difference"
|
||||
190 CALL PrintRow(20.0, 45.0)
|
||||
200 CALL PrintRow(-45.0, 45.0)
|
||||
210 CALL PrintRow(-85.0, 90.0)
|
||||
220 CALL PrintRow(-95.0, 90.0)
|
||||
230 CALL PrintRow(-45.0, 125.0)
|
||||
240 CALL PrintRow(-45.0, 145.0)
|
||||
250 CALL PrintRow(-45.0, 125.0)
|
||||
260 CALL PrintRow(-45.0, 145.0)
|
||||
270 CALL PrintRow(29.4803, -88.6381)
|
||||
280 CALL PrintRow(-78.3251, -159.036)
|
||||
290 PRINT
|
||||
300 PRINT "Input in wider range"
|
||||
310 PRINT " Bearing 1 Bearing 2 Difference"
|
||||
320 CALL PrintRow(-70099.74233810938, 29840.67437876723)
|
||||
330 CALL PrintRow(-165313.6666297357, 33693.9894517456)
|
||||
340 CALL PrintRow(1174.8380510598456, -154146.66490124757)
|
||||
350 CALL PrintRow(60175.77306795546, 42213.07192354373)
|
||||
360 END
|
||||
370 REM
|
||||
380 EXTERNAL FUNCTION GetDiff (B1, B2)
|
||||
390 LET R = MOD(B2 - B1, 360.0)
|
||||
400 IF R >= 180.0 THEN LET R = R - 360.0
|
||||
410 LET GetDiff = R
|
||||
420 END FUNCTION
|
||||
|
|
@ -2,34 +2,40 @@
|
|||
#include <iostream>
|
||||
using namespace std;
|
||||
|
||||
double getDifference(double b1, double b2) {
|
||||
double r = fmod(b2 - b1, 360.0);
|
||||
if (r < -180.0)
|
||||
r += 360.0;
|
||||
if (r >= 180.0)
|
||||
r -= 360.0;
|
||||
return r;
|
||||
double getDifference(double b1, double b2)
|
||||
{
|
||||
double r = fmod(b2 - b1, 360.0);
|
||||
if (r < -180.0)
|
||||
r += 360.0;
|
||||
if (r >= 180.0)
|
||||
r -= 360.0;
|
||||
return r;
|
||||
}
|
||||
|
||||
inline void printRow(double b1, double b2)
|
||||
{
|
||||
cout << getDifference(b1, b2) << endl;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
cout << "Input in -180 to +180 range" << endl;
|
||||
cout << getDifference(20.0, 45.0) << endl;
|
||||
cout << getDifference(-45.0, 45.0) << endl;
|
||||
cout << getDifference(-85.0, 90.0) << endl;
|
||||
cout << getDifference(-95.0, 90.0) << endl;
|
||||
cout << getDifference(-45.0, 125.0) << endl;
|
||||
cout << getDifference(-45.0, 145.0) << endl;
|
||||
cout << getDifference(-45.0, 125.0) << endl;
|
||||
cout << getDifference(-45.0, 145.0) << endl;
|
||||
cout << getDifference(29.4803, -88.6381) << endl;
|
||||
cout << getDifference(-78.3251, -159.036) << endl;
|
||||
|
||||
cout << "Input in wider range" << endl;
|
||||
cout << getDifference(-70099.74233810938, 29840.67437876723) << endl;
|
||||
cout << getDifference(-165313.6666297357, 33693.9894517456) << endl;
|
||||
cout << getDifference(1174.8380510598456, -154146.66490124757) << endl;
|
||||
cout << getDifference(60175.77306795546, 42213.07192354373) << endl;
|
||||
cout << "Input in -180 to +180 range" << endl;
|
||||
printRow(20.0, 45.0);
|
||||
printRow(-45.0, 45.0);
|
||||
printRow(-85.0, 90.0);
|
||||
printRow(-95.0, 90.0);
|
||||
printRow(-45.0, 125.0);
|
||||
printRow(-45.0, 145.0);
|
||||
printRow(-45.0, 125.0);
|
||||
printRow(-45.0, 145.0);
|
||||
printRow(29.4803, -88.6381);
|
||||
printRow(-78.3251, -159.036);
|
||||
|
||||
return 0;
|
||||
cout << endl << "Input in wider range" << endl;
|
||||
printRow(-70099.74233810938, 29840.67437876723);
|
||||
printRow(-165313.6666297357, 33693.9894517456);
|
||||
printRow(1174.8380510598456, -154146.66490124757);
|
||||
printRow(60175.77306795546, 42213.07192354373);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,38 @@
|
|||
<?php
|
||||
// Angle difference between two bearings
|
||||
|
||||
function get_diff($b1, $b2) {
|
||||
$r = ($b2 - $b1) - intdiv($b2 - $b1, 360) * 360;
|
||||
if ($r > 180.0)
|
||||
$r -= 360.0;
|
||||
if ($r < -180.0)
|
||||
$r += 360.0;
|
||||
return $r;
|
||||
}
|
||||
|
||||
function echo_row($b1, $b2) {
|
||||
echo str_pad(number_format($b1, 6, ".", ""), 14, " ", STR_PAD_LEFT).' ';
|
||||
echo str_pad(number_format($b2, 6, ".", ""), 14, " ", STR_PAD_LEFT).' ';
|
||||
echo str_pad(number_format(get_diff($b1, $b2), 6), 14, " ", STR_PAD_LEFT);
|
||||
echo "\n";
|
||||
}
|
||||
|
||||
echo "Input in -180 to +180 range\n";
|
||||
echo " Bearing 1 Bearing 2 Difference\n";
|
||||
echo_row(20.0, 45.0);
|
||||
echo_row(-45.0, 45.0);
|
||||
echo_row(-85.0, 90.0);
|
||||
echo_row(-95.0, 90.0);
|
||||
echo_row(-45.0, 125.0);
|
||||
echo_row(-45.0, 145.0);
|
||||
echo_row(-45.0, 125.0);
|
||||
echo_row(-45.0, 145.0);
|
||||
echo_row(29.4803, -88.6381);
|
||||
echo_row(-78.3251, -159.036);
|
||||
echo "\nInput in wider range\n";
|
||||
echo " Bearing 1 Bearing 2 Difference\n";
|
||||
echo_row(-70099.74233810938, 29840.67437876723);
|
||||
echo_row(-165313.6666297357, 33693.9894517456);
|
||||
echo_row(1174.8380510598456, -154146.66490124757);
|
||||
echo_row(60175.77306795546, 42213.07192354373);
|
||||
?>
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
include "NSLog.incl"
|
||||
|
||||
double local fn Normalize( f as double, n as double )
|
||||
double a = f
|
||||
while ( a < -n ) : a += n : wend
|
||||
while ( a >= n ) : a -= n : wend
|
||||
end fn = a
|
||||
|
||||
double local fn NormalizeToDegrees( f as double ) return fn Normalize( f, 360 ) end fn = 0.0
|
||||
double local fn NormalizeToGradians( f as double ) return fn Normalize( f, 400 ) end fn = 0.0
|
||||
double local fn NormalizeToMils( f as double ) return fn Normalize( f, 6400 ) end fn = 0.0
|
||||
double local fn NormalizeToRadians( f as double ) return fn Normalize( f, 2 * M_PI ) end fn = 0.0
|
||||
|
||||
double local fn d2g( f as double ) return f * 10 / 9 end fn = 0.0
|
||||
double local fn d2m( f as double ) return f * 160 / 9 end fn = 0.0
|
||||
double local fn d2r( f as double ) return f * M_PI / 180 end fn = 0.0
|
||||
|
||||
double local fn g2d( f as double ) return f * 9 / 10 end fn = 0.0
|
||||
double local fn g2m( f as double ) return f * 16 end fn = 0.0
|
||||
double local fn g2r( f as double ) return f * M_PI / 200 end fn = 0.0
|
||||
|
||||
double local fn m2d( f as double ) return f * 9 / 160 end fn = 0.0
|
||||
double local fn m2g( f as double ) return f / 16 end fn = 0.0
|
||||
double local fn m2r( f as double ) return f * M_PI / 3200 end fn = 0.0
|
||||
|
||||
double local fn r2d( f as double ) return f * 180 / M_PI end fn = 0.0
|
||||
double local fn r2g( f as double ) return f * 200 / M_PI end fn = 0.0
|
||||
double local fn r2m( f as double ) return f * 3200 / M_PI end fn = 0.0
|
||||
|
||||
local fn CalculateDegrees
|
||||
CFArrayRef angles = @[@-2, @-1, @0, @1, @2, @6.2831853, @16, @57.2957795, @359, @6399, @1000000]
|
||||
double angle, degrees, gradians, mils, radians
|
||||
NSUInteger i
|
||||
CFStringRef unit
|
||||
CFStringRef dashpad = fn StringByPaddingToLength( @"", 73, @"-", 0 )
|
||||
|
||||
ptr anglePtr = fn StringUTF8String( @"Angle" )
|
||||
ptr unitPtr = fn StringUTF8String( @"Unit" )
|
||||
ptr normalPtr = fn StringUTF8String( @"Normalized" )
|
||||
ptr gradiansPtr = fn StringUTF8String( @"Gradians" )
|
||||
ptr milsPtr = fn StringUTF8String( @"Mils" )
|
||||
ptr radiansPtr = fn StringUTF8String( @"Radians" )
|
||||
|
||||
// Header
|
||||
NSLog( @"\n%@", dashpad )
|
||||
NSLog( @"%13s %5s %15s %10s %7s %15s", anglePtr, unitPtr, normalPtr, gradiansPtr, milsPtr, radiansPtr )
|
||||
NSLog( @"%@", dashpad )
|
||||
|
||||
// Degrees
|
||||
for i = 0 to fn ArrayCount( angles ) - 1
|
||||
angle = dblval( angles[i] )
|
||||
unit = @"Degrees"
|
||||
degrees = fn NormalizeToDegrees( angle )
|
||||
gradians = fn NormalizeToGradians( fn d2g( degrees ) )
|
||||
mils = fn NormalizeToMils( fn d2m( degrees ) )
|
||||
radians = fn NormalizeToRadians( fn d2r( degrees ) )
|
||||
NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians )
|
||||
next
|
||||
NSLog( @"" )
|
||||
|
||||
// Gradians
|
||||
for i = 0 to fn ArrayCount( angles ) - 1
|
||||
angle = dblval( angles[i] )
|
||||
unit = @"Gradians"
|
||||
gradians = fn NormalizeToGradians( angle )
|
||||
degrees = fn NormalizeToDegrees( fn g2d( gradians ) )
|
||||
mils = fn NormalizeToMils( fn g2m( gradians ) )
|
||||
radians = fn NormalizeToRadians( fn g2r( gradians ) )
|
||||
NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians )
|
||||
next
|
||||
NSLog( @"" )
|
||||
|
||||
// Mils
|
||||
for i = 0 to fn ArrayCount( angles ) - 1
|
||||
angle = dblval( angles[i] )
|
||||
unit = @"Mils"
|
||||
mils = fn NormalizeToMils( angle )
|
||||
degrees = fn NormalizeToDegrees( fn m2d( mils ) )
|
||||
gradians = fn NormalizeToGradians( fn m2g( mils ) )
|
||||
radians = fn NormalizeToRadians( fn m2r( mils ) )
|
||||
NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians )
|
||||
next
|
||||
NSLog( @"" )
|
||||
|
||||
// Radians
|
||||
for i = 0 to fn ArrayCount( angles ) - 1
|
||||
angle = dblval( angles[i] )
|
||||
unit = @"Radians"
|
||||
radians = fn NormalizeToRadians( angle )
|
||||
degrees = fn NormalizeToDegrees( fn r2d( radians ) )
|
||||
gradians = fn NormalizeToGradians( fn r2g( radians ) )
|
||||
mils = fn NormalizeToMils( fn r2m( radians ) )
|
||||
NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians )
|
||||
next
|
||||
NSLog( @"%@", dashpad )
|
||||
end fn
|
||||
|
||||
fn CalculateDegrees
|
||||
|
||||
HandleEvents
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
10 mode 1
|
||||
20 theta=pi/2
|
||||
30 g=9.81
|
||||
40 l=1
|
||||
50 sp=0 : px=320 : py=300 : bx=px : by=py
|
||||
100 move bx-4,by+4:graphics pen 0:tag:print chr$(231);:tagoff
|
||||
110 move px,py:draw bx,by
|
||||
120 bx=px+l*250*sin(theta)
|
||||
130 by=py+l*250*cos(theta)
|
||||
140 move bx-4,by+4:graphics pen 1:tag:print chr$(231);:tagoff
|
||||
150 move px,py:draw bx,by
|
||||
160 accel=g*sin(theta)/l/100
|
||||
170 sp=sp+accel/100
|
||||
180 theta=theta+sp
|
||||
190 frame
|
||||
200 goto 100
|
||||
|
|
@ -3,82 +3,74 @@
|
|||
import math
|
||||
import times
|
||||
|
||||
import gintro/[gobject, gdk, gtk, gio, cairo]
|
||||
import gintro/glib except Pi
|
||||
import gtk2 except update
|
||||
import gdk2, glib2, cairo
|
||||
|
||||
type
|
||||
|
||||
# Description of the simulation.
|
||||
Simulation = ref object
|
||||
area: DrawingArea # Drawing area.
|
||||
Simulation = object
|
||||
area: PDrawingArea # Drawing area.
|
||||
length: float # Pendulum length.
|
||||
g: float # Gravity (should be positive).
|
||||
time: Time # Current time.
|
||||
theta0: float # initial angle.
|
||||
theta: float # Current angle.
|
||||
theta: float # Current drawangle.
|
||||
omega: float # Angular velocity = derivative of theta.
|
||||
accel: float # Angular acceleration = derivative of omega.
|
||||
e: float # Total energy.
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc newSimulation(area: DrawingArea; length, g, theta0: float): Simulation {.noInit.} =
|
||||
## Allocate and initialize the simulation object.
|
||||
proc initSimulation(area: PDrawingArea; length, g, theta0: float): Simulation {.noInit.} =
|
||||
## Initialize a simulation object.
|
||||
|
||||
new(result)
|
||||
result.area = area
|
||||
result.length = length
|
||||
result.g = g
|
||||
result.time = getTime()
|
||||
result.theta0 = theta0
|
||||
result.theta = theta0
|
||||
result.omega = 0
|
||||
result.accel = -g / length * sin(theta0)
|
||||
result.e = g * length * (1 - cos(theta0)) # Total energy = potential energy when starting.
|
||||
result = Simulation(
|
||||
area: area, length: length, g: g, time: getTime(),
|
||||
theta0: theta0, theta: theta0, omega: 0,
|
||||
accel: -g / length * sin(theta0),
|
||||
e: g * length * (1 - cos(theta0))) # Total energy = potential energy when starting.
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
template toFloat(dt: Duration): float = dt.inNanoseconds.float / 1e9
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
const Origin = (x: 320.0, y: 100.0) # Pivot coordinates.
|
||||
const Scale = 300 # Coordinates scaling constant.
|
||||
|
||||
proc draw(sim: Simulation; context: cairo.Context) =
|
||||
|
||||
proc draw(sim: var Simulation; context: ptr Context) =
|
||||
## Draw the pendulum.
|
||||
|
||||
# Compute coordinates in drawing area.
|
||||
# Compute coordinates in drawing draw.
|
||||
let x = Origin.x + sin(sim.theta) * Scale
|
||||
let y = Origin.y + cos(sim.theta) * Scale
|
||||
|
||||
# Clear the region.
|
||||
# Clear the region.draw
|
||||
context.moveTo(0, 0)
|
||||
context.setSource(0.0, 0.0, 0.0)
|
||||
context.setSourceRgb(0.0, 0.0, 0.0)
|
||||
context.paint()
|
||||
|
||||
# Draw pendulum.
|
||||
context.moveTo(Origin.x, Origin.y)
|
||||
context.setSource(0.3, 1.0, 0.3)
|
||||
context.setSourceRgb(0.3, 1.0, 0.3)
|
||||
context.lineTo(x, y)
|
||||
context.stroke()
|
||||
|
||||
# Draw pivot.
|
||||
context.setSource(0.3, 0.3, 1.0)
|
||||
context.setSourceRgb(0.3, 0.3, 1.0)
|
||||
context.arc(Origin.x, Origin.y, 8, 0, 2 * Pi)
|
||||
context.fill()
|
||||
|
||||
# Draw mass.
|
||||
context.setSource(1.0, 0.3, 0.3)
|
||||
context.setSourceRgb(1.0, 0.3, 0.3)
|
||||
context.arc(x, y, 8, 0, 2 * Pi)
|
||||
context.fill()
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc update(sim: Simulation): gboolean =
|
||||
proc update(sim: var Simulation): gboolean =
|
||||
## Update the simulation state.
|
||||
|
||||
# compute time interval.
|
||||
# Compute time interval.
|
||||
let nextTime = getTime()
|
||||
let dt = (nextTime - sim.time).toFloat
|
||||
sim.time = nextTime
|
||||
|
|
@ -100,26 +92,25 @@ proc update(sim: Simulation): gboolean =
|
|||
|
||||
sim.draw(sim.area.window.cairoCreate())
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc activate(app: Application) =
|
||||
## Activate the application.
|
||||
proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} =
|
||||
## Quit the application.
|
||||
mainQuit()
|
||||
|
||||
let window = app.newApplicationWindow()
|
||||
window.setSizeRequest(640, 480)
|
||||
window.setTitle("Pendulum simulation")
|
||||
|
||||
let area = newDrawingArea()
|
||||
window.add(area)
|
||||
nimInit()
|
||||
|
||||
let sim = newSimulation(area, length = 5, g = 9.81, theta0 = PI / 3)
|
||||
let window = windowNew(WINDOW_TOPLEVEL)
|
||||
window.setSizeRequest(640, 480)
|
||||
window.setTitle("Pendulum simulation")
|
||||
|
||||
timeoutAdd(10, update, sim)
|
||||
let area = drawingAreaNew()
|
||||
window.add area
|
||||
discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil)
|
||||
|
||||
window.showAll()
|
||||
var sim = initSimulation(area, length = 5, g = 9.81, theta0 = PI / 3)
|
||||
|
||||
#———————————————————————————————————————————————————————————————————————————————————————————————————
|
||||
discard timeoutAdd(10, cast[gtk2.TFunction](update), sim.addr)
|
||||
|
||||
let app = newApplication(Application, "Rosetta.pendulum")
|
||||
discard app.connect("activate", activate)
|
||||
discard app.run()
|
||||
window.showAll()
|
||||
main()
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
s$ = "Hello world! "
|
||||
textsize 16
|
||||
textsize 14
|
||||
lg = len s$
|
||||
on timer
|
||||
color 333
|
||||
|
|
@ -7,13 +7,13 @@ on timer
|
|||
rect 80 20
|
||||
color 999
|
||||
move 12 24
|
||||
text s$
|
||||
if forw = 0
|
||||
text substr s$ 1 9
|
||||
if forw = 1
|
||||
s$ = substr s$ lg 1 & substr s$ 1 (lg - 1)
|
||||
else
|
||||
s$ = substr s$ 2 (lg - 1) & substr s$ 1 1
|
||||
.
|
||||
timer 0.2
|
||||
timer 0.4
|
||||
.
|
||||
on mouse_down
|
||||
if mouse_x > 10 and mouse_x < 90
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
import gintro/[glib, gobject, gdk, gtk, gio]
|
||||
import gtk2, gdk2, glib2
|
||||
|
||||
type
|
||||
|
||||
|
|
@ -6,56 +6,56 @@ type
|
|||
ScrollDirection = enum toLeft, toRight
|
||||
|
||||
# Data transmitted to update callback.
|
||||
UpdateData = ref object
|
||||
label: Label
|
||||
UpdateData = object
|
||||
label: PLabel
|
||||
scrollDir: ScrollDirection
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc update(data: UpdateData): gboolean =
|
||||
proc update(data: var UpdateData): gboolean {.cdecl.} =
|
||||
## Update the text, scrolling to the right or to the left according to "data.scrollDir".
|
||||
|
||||
data.label.setText(if data.scrollDir == toRight: data.label.text[^1] & data.label.text[0..^2]
|
||||
else: data.label.text[1..^1] & data.label.text[0])
|
||||
let text = $data.label.text # Get text as a Nim string.
|
||||
let newText = if data.scrollDir == toRight: text[^1] & text[0..^2]
|
||||
else: text[1..^1] & text[0]
|
||||
data.label.setText(newText.cstring)
|
||||
result = gboolean(1)
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc changeScrollingDir(evtBox: EventBox; event: EventButton; data: UpdateData): bool =
|
||||
proc changeScrollingDir(evtBox: PEventBox; event: PEventButton; data: ptr UpdateData): bool =
|
||||
## Change scrolling direction.
|
||||
|
||||
data.scrollDir = ScrollDirection(1 - ord(data.scrollDir))
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc activate(app: Application) =
|
||||
## Activate the application.
|
||||
proc onDestroyEvent(widget: PWidget; data: Pgpointer): gboolean {.cdecl.} =
|
||||
## Process the "destroy" event.
|
||||
main_quit()
|
||||
|
||||
let window = app.newApplicationWindow()
|
||||
window.setSizeRequest(150, 50)
|
||||
window.setTitle("Animation")
|
||||
|
||||
# Create an event box to catch the button press event.
|
||||
let evtBox = newEventBox()
|
||||
window.add(evtBox)
|
||||
|
||||
# Create the label and add it to the event box.
|
||||
let label = newLabel("Hello World! ")
|
||||
evtBox.add(label)
|
||||
nim_init()
|
||||
|
||||
# Create the update data.
|
||||
let data = UpdateData(label: label, scrollDir: toRight)
|
||||
let window = window_new(WINDOW_TOPLEVEL)
|
||||
window.set_size_request(150, 50)
|
||||
window.set_title("Animation")
|
||||
|
||||
# Connect the "button-press-event" to the callback to change scrolling direction.
|
||||
discard evtBox.connect("button-press-event", changeScrollingDir, data)
|
||||
# Create an event box to catch the button press event.
|
||||
let evtBox = event_box_new()
|
||||
window.add evtBox
|
||||
|
||||
# Create a timer to update the label and simulate scrolling.
|
||||
timeoutAdd(200, update, data)
|
||||
# Create the label and add it to the event box.
|
||||
let label = label_new("Hello World! ")
|
||||
evtBox.add label
|
||||
|
||||
window.showAll()
|
||||
# Create the update data.
|
||||
var data = UpdateData(label: label, scrollDir: toRight)
|
||||
|
||||
#———————————————————————————————————————————————————————————————————————————————————————————————————
|
||||
# Connect the "button-press-event" to the callback to change the scrolling direction.
|
||||
discard evtBox.signal_connect("button-press-event", SIGNAL_FUNC(changeScrollingDir), data.addr)
|
||||
|
||||
let app = newApplication(Application, "Rosetta.animation")
|
||||
discard app.connect("activate", activate)
|
||||
discard app.run()
|
||||
# Quit the application if the window is closed.
|
||||
discard window.signal_connect("destroy", SIGNAL_FUNC(onDestroyEvent), nil)
|
||||
|
||||
# Create a timer to update the label and simulate scrolling.
|
||||
discard timeout_add(200, cast[gtk2.TFunction](animation.update), data.addr)
|
||||
|
||||
window.showAll()
|
||||
main()
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
writeln map(fn{^2}, 1..10)
|
||||
writeln map(1..10, by=fn{^2})
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@ val xs = string(5 ^ 4 ^ 3 ^ 2)
|
|||
|
||||
writeln len(xs), " digits"
|
||||
|
||||
if len(xs) > 39 and s2s(xs, 1..20) == "62060698786608744707" and
|
||||
s2s(xs, -20 .. -1) == "92256259918212890625" {
|
||||
if len(xs) > 39 and s2s(xs, of=1..20) == "62060698786608744707" and
|
||||
s2s(xs, of=-20 .. -1) == "92256259918212890625" {
|
||||
|
||||
writeln "SUCCESS"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,17 @@
|
|||
module checkit {
|
||||
z=4^(3^2)
|
||||
z1=z/1024-1
|
||||
m=Biginteger("5")
|
||||
with m, "ToString" as m.ToString
|
||||
p=Biginteger("1024")
|
||||
method m, "intpower", p as m1
|
||||
m=m1
|
||||
for i=1 to z1
|
||||
method m1, "multiply", m as m
|
||||
? len(m.tostring), i
|
||||
refresh
|
||||
next
|
||||
a=m.tostring
|
||||
Print left$(a, 20)+"..."+Right$(a,20)
|
||||
}
|
||||
checkit
|
||||
|
|
@ -1,17 +1,18 @@
|
|||
with Ada.Numerics.Elementary_Functions;
|
||||
|
||||
with SDL.Video.Windows.Makers;
|
||||
with SDL.Video.Rectangles;
|
||||
with SDL.Video.Renderers.Makers;
|
||||
with SDL.Events.Events;
|
||||
|
||||
procedure Archimedean_Spiral is
|
||||
|
||||
Width : constant := 800;
|
||||
Height : constant := 800;
|
||||
A : constant := 4.2;
|
||||
B : constant := 3.2;
|
||||
T_First : constant := 4.0;
|
||||
T_Last : constant := 100.0;
|
||||
Width : constant := 800;
|
||||
Height : constant := 800;
|
||||
A : constant := 4.2;
|
||||
B : constant := 3.2;
|
||||
T_First : constant := 4.0;
|
||||
T_Last : constant := 100.0;
|
||||
|
||||
Window : SDL.Video.Windows.Window;
|
||||
Renderer : SDL.Video.Renderers.Renderer;
|
||||
|
|
@ -29,8 +30,10 @@ procedure Archimedean_Spiral is
|
|||
loop
|
||||
R := A + B * T;
|
||||
Renderer.Draw
|
||||
(Point => (X => Width / 2 + SDL.C.int (R * Cos (T, 2.0 * Pi)),
|
||||
Y => Height / 2 - SDL.C.int (R * Sin (T, 2.0 * Pi))));
|
||||
(Point =>
|
||||
SDL.Video.Rectangles.Point'
|
||||
(X => Width / 2 + SDL.C.int (R * Cos (T, 2.0 * Pi)),
|
||||
Y => Height / 2 - SDL.C.int (R * Sin (T, 2.0 * Pi))));
|
||||
exit when T >= T_Last;
|
||||
T := T + Step;
|
||||
end loop;
|
||||
|
|
@ -53,14 +56,16 @@ begin
|
|||
return;
|
||||
end if;
|
||||
|
||||
SDL.Video.Windows.Makers.Create (Win => Window,
|
||||
Title => "Archimedean spiral",
|
||||
Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
|
||||
Size => SDL.Positive_Sizes'(Width, Height),
|
||||
Flags => 0);
|
||||
SDL.Video.Windows.Makers.Create
|
||||
(Win => Window,
|
||||
Title => "Archimedean spiral",
|
||||
Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
|
||||
Size => SDL.Positive_Sizes'(Width, Height),
|
||||
Flags => 0);
|
||||
SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
|
||||
Renderer.Set_Draw_Colour ((0, 0, 0, 255));
|
||||
Renderer.Fill (Rectangle => (0, 0, Width, Height));
|
||||
Renderer.Fill
|
||||
(Rectangle => SDL.Video.Rectangles.Rectangle'(0, 0, Width, Height));
|
||||
Renderer.Set_Draw_Colour ((0, 220, 0, 255));
|
||||
|
||||
Draw_Archimedean_Spiral;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
10 PRINT CHR$(11);
|
||||
20 PI=3.141593
|
||||
30 FOR I=0 TO 1080
|
||||
40 R=I/42+2
|
||||
50 X=R*SIN(I*PI/180)
|
||||
60 Y=R*COS(I*PI/180)*1.4
|
||||
70 PSET(39+X,33+Y)
|
||||
80 NEXT
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
10 GRAPHICS 8:COLOR 0:DEG
|
||||
20 N=5.4
|
||||
30 FOR I=0 TO N*360 STEP 10
|
||||
40 R=I/24+4
|
||||
50 X=R*SIN(I)
|
||||
60 Y=R*COS(I)
|
||||
70 DRAWTO 160+X,80+Y
|
||||
80 COLOR 1
|
||||
90 NEXT I
|
||||
42
Task/Archimedean-spiral/Crystal/archimedean-spiral.cr
Normal file
42
Task/Archimedean-spiral/Crystal/archimedean-spiral.cr
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
# output utilities -- solution starts after them
|
||||
def print_line (line)
|
||||
(0..line[0].size-1).step(2) do |i|
|
||||
char = ((line[0][i] | line[1][i] << 1 | line[2][i] << 2 |
|
||||
line[0][i+1] << 3 | line[1][i+1] << 4 | line[2][i+1] << 5 |
|
||||
line[3][i] << 6 | line[3][i+1] << 7) + 0x2800).chr
|
||||
print char
|
||||
end
|
||||
puts
|
||||
end
|
||||
|
||||
def print_dots (coords, screen_width)
|
||||
coords = coords.sort_by {|x, y| y}
|
||||
left, right = coords.map(&.first).minmax
|
||||
if screen_width.odd?
|
||||
screen_width -= 1
|
||||
end
|
||||
factor = screen_width / (right - left + 1)
|
||||
line = (0..3).map { Array(UInt32).new(screen_width, 0) }
|
||||
row = (coords[0].last * factor).to_i
|
||||
coords.map {|x, y| {((x - left) * factor).to_i, (y * factor).to_i} }.each do |x, y|
|
||||
while y > row+3
|
||||
print_line line
|
||||
line.each do |stripe| stripe.fill(0) end
|
||||
row += 4
|
||||
end
|
||||
line[y - row][x] = 1
|
||||
end
|
||||
print_line line
|
||||
end
|
||||
|
||||
# actual solution starts here:
|
||||
|
||||
def spiral (a, b, step_resolution, step_count)
|
||||
start, stop = 0.0, step_count * step_resolution
|
||||
(start..stop).step(step_resolution).map { |theta|
|
||||
r = a + b * theta
|
||||
{ r * Math.cos(theta), r * Math.sin(theta) }
|
||||
}.to_a
|
||||
end
|
||||
|
||||
print_dots(spiral(10, 10, 0.01, 4000), 60)
|
||||
|
|
@ -5,7 +5,7 @@ module Archimedean_spiral {
|
|||
pen #FFFF00
|
||||
refresh 5000
|
||||
every 1000 {
|
||||
\\ redifine window (console width and height) and place it to center (symbol ;)
|
||||
\\ redefine window (console width and height) and place it to center (symbol ;)
|
||||
Window 12, random(10, 18)*1000, random(8, 12)*1000;
|
||||
move scale.x/2, scale.y/2
|
||||
let N=2, k1=pi/120, k=k1, op=5, op1=1
|
||||
|
|
|
|||
|
|
@ -1,38 +1,38 @@
|
|||
import math
|
||||
|
||||
import gintro/[glib, gobject, gtk, gio, cairo]
|
||||
import std/math
|
||||
import cairo
|
||||
|
||||
const
|
||||
|
||||
Width = 601
|
||||
Height = 601
|
||||
Width = 400
|
||||
Height = 400
|
||||
|
||||
Limit = 12 * math.PI
|
||||
|
||||
Origin = (x: float(Width div 2), y: float(Height div 2))
|
||||
B = floor((Width div 2) / Limit)
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc draw(area: DrawingArea; context: Context) =
|
||||
proc drawSpiral(surface: ptr Surface) =
|
||||
## Draw the spiral.
|
||||
|
||||
let context = create(surface)
|
||||
|
||||
var theta = 0.0
|
||||
var delta = 0.01
|
||||
var (prevx, prevy) = Origin
|
||||
|
||||
# Clear the region.
|
||||
context.moveTo(0, 0)
|
||||
context.setSource(0.0, 0.0, 0.0)
|
||||
context.setSourceRgb(0.0, 0.0, 0.0)
|
||||
context.paint()
|
||||
|
||||
# Draw the spiral.
|
||||
context.setSource(1.0, 1.0, 0.0)
|
||||
context.setSourceRgb(1.0, 1.0, 0.0)
|
||||
context.moveTo(Origin.x, Origin.y)
|
||||
while theta < Limit:
|
||||
let r = B * theta
|
||||
let x = Origin.x + r * cos(theta) # X-coordinate on drawing area.
|
||||
let y = Origin.y + r * sin(theta) # Y-coordinate on drawing area.
|
||||
let x = Origin.x + r * cos(theta)
|
||||
let y = Origin.y + r * sin(theta)
|
||||
context.lineTo(x, y)
|
||||
context.stroke()
|
||||
# Set data for next round.
|
||||
|
|
@ -41,34 +41,11 @@ proc draw(area: DrawingArea; context: Context) =
|
|||
prevy = y
|
||||
theta += delta
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
context.destroy()
|
||||
|
||||
proc onDraw(area: DrawingArea; context: Context; data: pointer): bool =
|
||||
## Callback to draw/redraw the drawing area contents.
|
||||
|
||||
area.draw(context)
|
||||
result = true
|
||||
|
||||
#---------------------------------------------------------------------------------------------------
|
||||
|
||||
proc activate(app: Application) =
|
||||
## Activate the application.
|
||||
|
||||
let window = app.newApplicationWindow()
|
||||
window.setSizeRequest(Width, Height)
|
||||
window.setTitle("Archimedean spiral")
|
||||
|
||||
# Create the drawing area.
|
||||
let area = newDrawingArea()
|
||||
window.add(area)
|
||||
|
||||
# Connect the "draw" event to the callback to draw the spiral.
|
||||
discard area.connect("draw", ondraw, pointer(nil))
|
||||
|
||||
window.showAll()
|
||||
|
||||
#———————————————————————————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
let app = newApplication(Application, "Rosetta.spiral")
|
||||
discard app.connect("activate", activate)
|
||||
discard app.run()
|
||||
let surface = imageSurfaceCreate(FormatRgb24, Width, Height)
|
||||
surface.drawSpiral()
|
||||
if surface.writeToPng("archimedean_spiral.png") != StatusSuccess:
|
||||
quit "Error while saving file.", QuitFailure
|
||||
surface.destroy()
|
||||
|
|
|
|||
22
Task/Arithmetic-Complex/Langur/arithmetic-complex.langur
Normal file
22
Task/Arithmetic-Complex/Langur/arithmetic-complex.langur
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
val conjugate = fn(c) {
|
||||
if c is not complex: throw "expected complex number"
|
||||
return complex(c[1], -c[2])
|
||||
}
|
||||
|
||||
val examples = {
|
||||
"-(1+1i)": -(1+1i),
|
||||
"abs(1+1i)": abs(1+1i),
|
||||
"(2+2i) + (5+13.2i)": (2+2i) + (5+13.2i),
|
||||
"5 + (2+2i)": 5 + (2+2i),
|
||||
"5i + (2+2i)": 5i + (2+2i),
|
||||
"5i - (2+2i)": 5i - (2+2i),
|
||||
"(1+1i) * (3.141592653589793+1.2i)": (1+1i) * (3.141592653589793+1.2i),
|
||||
"(5+3i) / (4-3i)": (5+3i) / (4-3i),
|
||||
"1 / (4-3i)": 1 / (4-3i),
|
||||
"(4-3i) ^ 3": (4-3i) ^ 3,
|
||||
"conjugate(7+21.0i)": conjugate(7+21.0i),
|
||||
}
|
||||
|
||||
for e of examples {
|
||||
writeln "{{e : 20}}: ", examples[e]
|
||||
}
|
||||
|
|
@ -0,0 +1,152 @@
|
|||
Class Complex {
|
||||
private:
|
||||
double vr, vi
|
||||
public:
|
||||
property real {
|
||||
value {link parent vr to vr : value=vr}
|
||||
}
|
||||
property imaginary {
|
||||
value {link parent vi to vi : value=vi}
|
||||
}
|
||||
property toString {
|
||||
value {
|
||||
clear
|
||||
' so default variable VALUE deleted and again defined it as string
|
||||
link parent vr, vi to vr, vi
|
||||
if vi then
|
||||
if vr then
|
||||
if vi>0 then
|
||||
if vi==1 then
|
||||
value="("+vr+"+i)"
|
||||
else
|
||||
value="("+vr+"+"+vi+"i)"
|
||||
end if
|
||||
else
|
||||
if vi==-1 then
|
||||
value="("+vr+"-i)"
|
||||
else
|
||||
value="("+vr+""+vi+"i)"
|
||||
end if
|
||||
end if
|
||||
else
|
||||
if vi=1 then
|
||||
value="(i)"
|
||||
else.if vi=-1 then
|
||||
value="(-i)"
|
||||
else
|
||||
value="("+vi+"i)"
|
||||
end if
|
||||
end if
|
||||
else
|
||||
value="("+vr+")"
|
||||
end if
|
||||
}
|
||||
}
|
||||
function final Arg {
|
||||
declare m math
|
||||
Method m, "Atan2", .vi, .vr as ret
|
||||
=ret
|
||||
}
|
||||
function final exp(rr=10) {
|
||||
double exp = 2.71828182845905^.vr
|
||||
c=this
|
||||
th=.vi/1.74532925199433E-02
|
||||
c.vr<=round(exp * cos(th), rr)
|
||||
c.vi<=round(exp * sin(th),rr)
|
||||
=c
|
||||
}
|
||||
function final cabs {
|
||||
if abs(.vr)=infinity or abs(.vi)=infinity then
|
||||
=1.7976931348623157E+308 : break
|
||||
end if
|
||||
double c=abs(.vr), d=abs(.vi)
|
||||
if c>d then
|
||||
r=d/c : =c*sqrt(1+r*r)
|
||||
else.if d==0 then
|
||||
=c
|
||||
else
|
||||
r=c/d : =d*sqrt(1+r*r)
|
||||
end if
|
||||
}
|
||||
function final clog {
|
||||
c=this
|
||||
c.vr<=ln(.cabs())
|
||||
c.vi<=.Arg()
|
||||
=c
|
||||
}
|
||||
function final pow {
|
||||
if match("G") then
|
||||
read p as Complex
|
||||
else
|
||||
read p1 as double
|
||||
p=this:p.vr=p1:p.vi=0
|
||||
end if
|
||||
Read ? rr=10
|
||||
exp=.clog()*p
|
||||
c=exp.exp(rr)
|
||||
c.vr=round(c.vr, rr)
|
||||
c.vi=round(c.vi, rr)
|
||||
=c
|
||||
}
|
||||
function final inv {
|
||||
if .vr==0 and .vi==0 then error "zero complex num"
|
||||
acb=this.conj()
|
||||
c=this*acb
|
||||
c.vi <= acb.vi/c.vr
|
||||
c.vr <= acb.vr/c.vr
|
||||
=c
|
||||
}
|
||||
function final conj {
|
||||
c=this : c.vi-! : =c
|
||||
}
|
||||
function final absc {
|
||||
c=this*.conj() : =sqrt(c.vr)
|
||||
}
|
||||
operator final "+" {
|
||||
read k as Complex : .vr+= k.vr : .vi+= k.vi
|
||||
}
|
||||
operator final "-" {
|
||||
read k as Complex : .vr-= k.vr : .vi-= k.vi
|
||||
}
|
||||
operator final high "*" {
|
||||
read k as Complex
|
||||
double ivr = .vr*k.vr-.vi*k.vi
|
||||
.vi <= .vi*k.vr+.vr*k.vi
|
||||
.vr <= ivr
|
||||
}
|
||||
operator final high "/" {
|
||||
read k as Complex
|
||||
k1=k*k.conj()
|
||||
acb = this*k.conj()
|
||||
.vr <= acb.vr/k1.vr
|
||||
.vi <= acb.vi/k1.vr
|
||||
}
|
||||
operator final unary {
|
||||
.vr-!
|
||||
.vi-!
|
||||
}
|
||||
|
||||
class:
|
||||
module Complex (.vr, .vi) {}
|
||||
}
|
||||
Module Check (filename as string="") {
|
||||
def f(x)=x.toString
|
||||
a=Complex(8,-3)
|
||||
b=a.inv()
|
||||
open filename for wide output as #f
|
||||
Print #f, "A="+a.toString
|
||||
Print #f, " r=";a.cabs();" θ=";a.Arg();" rad"
|
||||
Print #f, "B="+b.toString+" as 1/A"
|
||||
Print #f, " r=";b.cabs();" θ=";b.Arg();" rad"
|
||||
Print #f, a.toString+"*"+b.toString+"="+f(a*b)
|
||||
Print #f, Complex(1).toString+"/"+b.toString+"="+f(Complex(1)/b)
|
||||
Print #f, a.toString+"/"+a.toString+"="+f(a/a)
|
||||
Print #f, a.toString+"+"+a.toString+"="+f(a+a)
|
||||
Print #f, a.toString+"-"+a.toString+"="+f(a-a)
|
||||
Print #f, "-"+a.toString+"="+f(-a)
|
||||
Print #f, "e^(πi)+1="+f(Complex(2.71828182845905).pow(Complex(0,pi))+Complex(1))
|
||||
close #f
|
||||
if filename<>"" then if exist(filename) then win "notepad", dir$+filename
|
||||
}
|
||||
Check "out.txt"
|
||||
Check ' just show here
|
||||
|
|
@ -1,23 +1,38 @@
|
|||
/*REXX program demonstrates how to support some math functions for complex numbers. */
|
||||
x = '(5,3i)' /*define X ─── can use I i J or j */
|
||||
y = "( .5, 6j)" /*define Y " " " " " " " */
|
||||
include Settings
|
||||
|
||||
say ' addition: ' x " + " y ' = ' Cadd(x, y)
|
||||
say ' subtraction: ' x " - " y ' = ' Csub(x, y)
|
||||
say 'multiplication: ' x " * " y ' = ' Cmul(x, y)
|
||||
say ' division: ' x " ÷ " y ' = ' Cdiv(x, y)
|
||||
say ' inverse: ' x " = " Cinv(x, y)
|
||||
say ' conjugate of: ' x " = " Conj(x, y)
|
||||
say ' negation of: ' x " = " Cneg(x, y)
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Conj: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a , -b )
|
||||
Cadd: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a+c , b+d )
|
||||
Csub: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a-c , b-d )
|
||||
Cmul: procedure; parse arg a ',' b,c ',' d; call C#; return C$( ac-bd , bc+ad)
|
||||
Cdiv: procedure; parse arg a ',' b,c ',' d; call C#; return C$((ac+bd)/s, (bc-ad)/s)
|
||||
Cinv: return Cdiv(1, arg(1))
|
||||
Cneg: return Cmul(arg(1), -1)
|
||||
C_: return word(translate(arg(1), , '{[(JjIi)]}') 0, 1) /*get # or 0*/
|
||||
C#: a=C_(a); b=C_(b); c=C_(c); d=C_(d); ac=a*c; ad=a*d; bc=b*c; bd=b*d;s=c*c+d*d; return
|
||||
C$: parse arg r,c; _='['r; if c\=0 then _=_","c'j'; return _"]" /*uses j */
|
||||
say version; say 'Arithmetic numbers'; say
|
||||
numeric digits 9
|
||||
divi. = 0; a = 0; c = 0
|
||||
do i = 1
|
||||
/* Is the number arithmetic? */
|
||||
if Arithmetic(i) then do
|
||||
a = a+1
|
||||
/* Is the number composite? */
|
||||
if divi.0 > 2 then
|
||||
c = c+1
|
||||
/* Output control */
|
||||
if a <= 100 then do
|
||||
if a = 1 then
|
||||
say 'First 100 arithmetic numbers are'
|
||||
call Charout ,Right(i,4)
|
||||
if a//10 = 0 then
|
||||
say
|
||||
if a = 100 then
|
||||
say
|
||||
end
|
||||
if a = 100 | a = 1000 | a = 10000 | a = 100000 | a = 1000000 then do
|
||||
say 'The' a'th arithmetic number is' i
|
||||
say 'Of the first' a 'numbers' c 'are composite'
|
||||
say
|
||||
end
|
||||
/* Max 1m, higher takes too long */
|
||||
if a = 1000000 then
|
||||
leave
|
||||
end
|
||||
end
|
||||
say Format(Time('e'),,3) 'seconds'
|
||||
exit
|
||||
|
||||
include Numbers
|
||||
include Functions
|
||||
include Abend
|
||||
|
|
|
|||
11
Task/Arithmetic-Complex/Uiua/arithmetic-complex.uiua
Normal file
11
Task/Arithmetic-Complex/Uiua/arithmetic-complex.uiua
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
Za ← ℂ 3 1.5 # 1.5+3i
|
||||
Zb ← ℂ 1.5 1.5 # 1.5+1.5i
|
||||
+ Zb Za
|
||||
- Zb Za
|
||||
× Zb Za
|
||||
÷ Zb Za
|
||||
¯Za
|
||||
ℂ¯ °ℂ Za
|
||||
⌵ Za
|
||||
ⁿ Zb Za
|
||||
°ℂZa
|
||||
23
Task/Arithmetic-Integer/Zig/arithmetic-integer.zig
Normal file
23
Task/Arithmetic-Integer/Zig/arithmetic-integer.zig
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
const std = @import("std");
|
||||
|
||||
pub fn main() !void {
|
||||
var buf: [1024]u8 = undefined;
|
||||
const reader = std.io.getStdIn().reader();
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
try stdout.writeAll("Enter two integers separated by a space: ");
|
||||
const input = try reader.readUntilDelimiter(&buf, '\n');
|
||||
const text = std.mem.trimRight(u8, input, "\r\n");
|
||||
|
||||
var it = std.mem.tokenizeScalar(u8, text, ' ');
|
||||
|
||||
const a = try std.fmt.parseInt(i64, it.next().?, 10);
|
||||
const b = try std.fmt.parseInt(i64, it.next().?, 10);
|
||||
|
||||
try stdout.print("Values: a {d} b {d}\n", .{a, b});
|
||||
try stdout.print("Sum: a + b = {d}\n", .{a + b});
|
||||
try stdout.print("Difference: a - b = {d}\n", .{a - b});
|
||||
try stdout.print("Product: a * b = {d}\n", .{a * b});
|
||||
try stdout.print("Integer quotient: a / b = {d}\n", .{@divTrunc(a, b)}); //truncates towards 0
|
||||
try stdout.print("Remainder: a % b = {d}\n", .{@rem(a, b)}); // same sign as first operand
|
||||
try stdout.print("Exponentiation: math.pow = {d}\n", .{std.math.pow(i64, a, b)}); //no exponentiation operator
|
||||
}
|
||||
|
|
@ -1,87 +1,62 @@
|
|||
/*REXX program implements a reasonably complete rational arithmetic (using fractions).*/
|
||||
L=length(2**19 - 1) /*saves time by checking even numbers. */
|
||||
do j=2 by 2 to 2**19 - 1; s=0 /*ignore unity (which can't be perfect)*/
|
||||
mostDivs=eDivs(j); @= /*obtain divisors>1; zero sum; null @. */
|
||||
do k=1 for words(mostDivs) /*unity isn't return from eDivs here.*/
|
||||
r='1/'word(mostDivs, k); @=@ r; s=$fun(r, , s)
|
||||
end /*k*/
|
||||
if s\==1 then iterate /*Is sum not equal to unity? Skip it.*/
|
||||
say 'perfect number:' right(j, L) " fractions:" @
|
||||
end /*j*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
$div: procedure; parse arg x; x=space(x,0); f= 'fractional division'
|
||||
parse var x n '/' d; d=p(d 1)
|
||||
if d=0 then call err 'division by zero:' x
|
||||
if \datatype(n,'N') then call err 'a non─numeric numerator:' x
|
||||
if \datatype(d,'N') then call err 'a non─numeric denominator:' x
|
||||
return n/d
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
$fun: procedure; parse arg z.1,,z.2 1 zz.2; arg ,op; op=p(op '+')
|
||||
F= 'fractionalFunction'; do j=1 for 2; z.j=translate(z.j, '/', "_"); end /*j*/
|
||||
if abbrev('ADD' , op) then op= "+"
|
||||
if abbrev('DIVIDE' , op) then op= "/"
|
||||
if abbrev('INTDIVIDE', op, 4) then op= "÷"
|
||||
if abbrev('MODULUS' , op, 3) | abbrev('MODULO', op, 3) then op= "//"
|
||||
if abbrev('MULTIPLY' , op) then op= "*"
|
||||
if abbrev('POWER' , op) then op= "^"
|
||||
if abbrev('SUBTRACT' , op) then op= "-"
|
||||
if z.1=='' then z.1= (op\=="+" & op\=='-')
|
||||
if z.2=='' then z.2= (op\=="+" & op\=='-')
|
||||
z_=z.2
|
||||
/* [↑] verification of both fractions.*/
|
||||
do j=1 for 2
|
||||
if pos('/', z.j)==0 then z.j=z.j"/1"; parse var z.j n.j '/' d.j
|
||||
if \datatype(n.j,'N') then call err 'a non─numeric numerator:' n.j
|
||||
if \datatype(d.j,'N') then call err 'a non─numeric denominator:' d.j
|
||||
if d.j=0 then call err 'a denominator of zero:' d.j
|
||||
n.j=n.j/1; d.j=d.j/1
|
||||
do while \datatype(n.j,'W'); n.j=(n.j*10)/1; d.j=(d.j*10)/1
|
||||
end /*while*/ /* [↑] {xxx/1} normalizes a number. */
|
||||
g=gcd(n.j, d.j); if g=0 then iterate; n.j=n.j/g; d.j=d.j/g
|
||||
end /*j*/
|
||||
include Settings
|
||||
|
||||
select
|
||||
when op=='+' | op=='-' then do; l=lcm(d.1,d.2); do j=1 for 2; n.j=l*n.j/d.j; d.j=l
|
||||
end /*j*/
|
||||
if op=='-' then n.2= -n.2; t=n.1 + n.2; u=l
|
||||
end
|
||||
when op=='**' | op=='↑' |,
|
||||
op=='^' then do; if \datatype(z_,'W') then call err 'a non─integer power:' z_
|
||||
t=1; u=1; do j=1 for abs(z_); t=t*n.1; u=u*d.1
|
||||
end /*j*/
|
||||
if z_<0 then parse value t u with u t /*swap U and T */
|
||||
end
|
||||
when op=='/' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
t=n.1*d.2; u=n.2*d.1
|
||||
end
|
||||
when op=='÷' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
t=trunc($div(n.1 '/' d.1)); u=1
|
||||
end /* [↑] this is integer division. */
|
||||
when op=='//' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
_=trunc($div(n.1 '/' d.1)); t=_ - trunc(_) * d.1; u=1
|
||||
end /* [↑] modulus division. */
|
||||
when op=='ABS' then do; t=abs(n.1); u=abs(d.1); end
|
||||
when op=='*' then do; t=n.1 * n.2; u=d.1 * d.2; end
|
||||
when op=='EQ' | op=='=' then return $div(n.1 '/' d.1) = fDiv(n.2 '/' d.2)
|
||||
when op=='NE' | op=='\=' | op=='╪' | ,
|
||||
op=='¬=' then return $div(n.1 '/' d.1) \= fDiv(n.2 '/' d.2)
|
||||
when op=='GT' | op=='>' then return $div(n.1 '/' d.1) > fDiv(n.2 '/' d.2)
|
||||
when op=='LT' | op=='<' then return $div(n.1 '/' d.1) < fDiv(n.2 '/' d.2)
|
||||
when op=='GE' | op=='≥' | op=='>=' then return $div(n.1 '/' d.1) >= fDiv(n.2 '/' d.2)
|
||||
when op=='LE' | op=='≤' | op=='<=' then return $div(n.1 '/' d.1) <= fDiv(n.2 '/' d.2)
|
||||
otherwise call err 'an illegal function:' op
|
||||
end /*select*/
|
||||
say version; say 'Rational arithmetic'; say
|
||||
a = '1 2'; b = '-3 4'; c = '5 -6'; d = '-7 -8'; e = 3; f = 1.666666666
|
||||
say 'VALUES'
|
||||
say 'a =' Rlst2form(a)
|
||||
say 'b =' Rlst2form(b)
|
||||
say 'c =' Rlst2form(c)
|
||||
say 'd =' Rlst2form(d)
|
||||
say 'e =' e
|
||||
say 'f =' f
|
||||
say
|
||||
say 'BASICS'
|
||||
say 'a+b =' Rlst2form(Radd(a,b))
|
||||
say 'a+b+c+d =' Rlst2form(Radd(a,b,c,d))
|
||||
say 'a-b =' Rlst2form(Rsub(a,b))
|
||||
say 'a-b-c-d =' Rlst2form(Rsub(a,b,c,d))
|
||||
say 'a*b =' Rlst2form(Rmul(a,b))
|
||||
say 'a*b*c*d =' Rlst2form(Rmul(a,b,c,d))
|
||||
say 'a/b =' Rlst2form(Rdiv(a,b))
|
||||
say 'a/b/c/d =' Rlst2form(Rdiv(a,b,c,d))
|
||||
say '-a =' Rlst2form(Rneg(a))
|
||||
say '1/a =' Rlst2form(Rinv(a))
|
||||
say
|
||||
say 'COMPARE'
|
||||
say 'a<b =' Rlt(a,b)
|
||||
say 'a<=b =' Rle(a,b)
|
||||
say 'a=b =' Req(a,b)
|
||||
say 'a>=b =' Rge(a,b)
|
||||
say 'a>b =' Rgt(a,b)
|
||||
say 'a<>b =' Rne(a,b)
|
||||
say
|
||||
say 'BONUS'
|
||||
say 'Abs(c) =' Rlst2form(Rabs(c))
|
||||
say 'Float(b) =' Rfloat(b)
|
||||
say 'Neg(d) =' Rlst2form(Rneg(d))
|
||||
say 'Power(a,e) =' Rlst2form(Rpow(a,e))
|
||||
say 'Rational(f) =' Rlst2form(Rrat(f))
|
||||
say
|
||||
say 'FORMULA'
|
||||
say 'a^2-2ab+3c-4ad^4+5 = ',
|
||||
Rlst2form(Radd(Rpow(a,2),Rmul(-2,a,b),Rmul(3,c),Rmul(-4,a,Rpow(d,4)),5))
|
||||
say
|
||||
say 'PERFECT NUMBERS'
|
||||
call time('r')
|
||||
numeric digits 20
|
||||
do c = 6 to 2**19
|
||||
s = 1 c; m = Isqrt(c)
|
||||
do f = 2 to m
|
||||
if c//f = 0 then do
|
||||
s = Radd(s,1 f,1 c/f)
|
||||
end
|
||||
end
|
||||
if Req(s,1) then
|
||||
say c 'is a perfect number'
|
||||
end
|
||||
say time('e')/1's'
|
||||
exit
|
||||
|
||||
if t==0 then return 0; g=gcd(t, u); t=t/g; u=u/g
|
||||
if u==1 then return t
|
||||
return t'/'u
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
eDivs: procedure; parse arg x 1 b,a
|
||||
do j=2 while j*j<x; if x//j\==0 then iterate; a=a j; b=x%j b; end
|
||||
if j*j==x then return a j b; return a b
|
||||
/*───────────────────────────────────────────────────────────────────────────────────────────────────*/
|
||||
err: say; say '***error*** ' f " detected" arg(1); say; exit 13
|
||||
gcd: procedure; parse arg x,y; if x=0 then return y; do until _==0; _=x//y; x=y; y=_; end; return x
|
||||
lcm: procedure; parse arg x,y; if y=0 then return 0; x=x*y/gcd(x, y); return x
|
||||
p: return word( arg(1), 1)
|
||||
include Rational
|
||||
include Functions
|
||||
include Abend
|
||||
|
|
|
|||
15
Task/Arithmetic-derivative/ABC/arithmetic-derivative.abc
Normal file
15
Task/Arithmetic-derivative/ABC/arithmetic-derivative.abc
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
HOW TO RETURN lagarias n:
|
||||
SELECT:
|
||||
n<0: RETURN -lagarias -n
|
||||
n in {0;1}: RETURN 0
|
||||
NO d IN {2..floor root n} HAS n mod d=0: RETURN 1
|
||||
ELSE: RETURN ((n/d) * lagarias d) + (d * lagarias (n/d))
|
||||
|
||||
PUT 0 IN col
|
||||
FOR n IN {-99..100}:
|
||||
WRITE (lagarias n)>>6
|
||||
PUT col+1 IN col
|
||||
IF col mod 10 = 0: WRITE/
|
||||
|
||||
FOR m IN {1..20}:
|
||||
WRITE "D(10^`m>>2`) = `(lagarias (10**m))/7`"/
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
FOR n FROM -99 TO 100 DO
|
||||
INT l := 0, f := 3, z := ABS n;
|
||||
WHILE z >= 2 DO
|
||||
WHILE z MOD 2 = 0 DO l +:= n OVER 2; z OVERAB 2 OD;
|
||||
IF f <= z THEN
|
||||
WHILE z MOD f = 0 DO l +:= n OVER f; z OVERAB f OD;
|
||||
f +:= 2
|
||||
FI
|
||||
OD;
|
||||
print( ( whole( l, -8 ) ) );
|
||||
IF ( n + 100 ) MOD 10 = 0 THEN print( ( newline ) ) FI
|
||||
OD
|
||||
7
Task/Arithmetic-derivative/APL/arithmetic-derivative.apl
Normal file
7
Task/Arithmetic-derivative/APL/arithmetic-derivative.apl
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
lagarias←{
|
||||
⍵<0:-∇-⍵
|
||||
⍵∊0 1:0
|
||||
0=d←⊃1+⍸0=(1↓⍳⌊⍵*÷2)|⍵:1
|
||||
(n×∇d)+d×∇n←⍵÷d
|
||||
}
|
||||
lagarias¨ 20 10⍴¯100+⍳200
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
PROC Main()
|
||||
INT n, f, l, z
|
||||
FOR n = -99 TO 100 DO
|
||||
l = 0 f = 3 IF n < 0 THEN z = - n ELSE z = n FI
|
||||
WHILE z >= 2 DO
|
||||
WHILE z MOD 2 = 0 DO l ==+ n / 2 z ==/ 2 OD
|
||||
IF f <= z THEN
|
||||
WHILE z MOD f = 0 DO l ==+ n / f z ==/ f OD
|
||||
f ==+ 2
|
||||
FI
|
||||
OD
|
||||
PrintF( "%8I", l )
|
||||
IF ( n + 100 ) MOD 10 = 0 THEN PutE() FI
|
||||
OD
|
||||
RETURN
|
||||
55
Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada
Normal file
55
Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
|
||||
with Ada.Numerics.Big_Numbers.Big_Integers; use Ada.Numerics.Big_Numbers.Big_Integers;
|
||||
|
||||
procedure Arithmetic_Derivative is
|
||||
|
||||
function D (N : Big_Integer) return Big_Integer is
|
||||
Inc : Constant array (1 .. 8) of Big_Integer := (4, 2, 4, 2, 4, 6, 2, 6);
|
||||
I : Integer := 1;
|
||||
Num : Big_Integer := N;
|
||||
P : Big_Integer := 2;
|
||||
PCount : Big_Integer;
|
||||
Result : Big_Integer := 0;
|
||||
begin
|
||||
if N < 0 then return -D(-N); end if;
|
||||
if N = 0 or N = 1 then return 0; end if;
|
||||
|
||||
while P <= N / 2 loop
|
||||
if Num mod P = 0 then
|
||||
PCount := 0;
|
||||
while Num mod P = 0 loop
|
||||
Num := Num / P;
|
||||
PCount := PCount + 1;
|
||||
end loop;
|
||||
Result := Result + (PCount * N) / P;
|
||||
end if;
|
||||
if Num = 1 then exit; end if;
|
||||
if P >= 7 then
|
||||
P := P + Inc(I);
|
||||
I := (I mod 8) + 1;
|
||||
end if;
|
||||
if P = 3 or P = 5 then P := P + 2; end if;
|
||||
if P = 2 then P := P + 1; end if;
|
||||
end loop;
|
||||
|
||||
if Num > 1 then return 1; end if;
|
||||
|
||||
return result;
|
||||
end D;
|
||||
|
||||
P : Big_Integer;
|
||||
|
||||
begin
|
||||
for I in Integer range -99 .. 100 loop
|
||||
P := To_Big_Integer(I);
|
||||
Put(To_String(Arg => D(P), Width => 5));
|
||||
if I mod 10 = 0 then New_Line; end if;
|
||||
end loop;
|
||||
|
||||
for I in Integer range 1 .. 20 loop
|
||||
P := 10 ** I;
|
||||
Put("D(10^"); Put(Item => I, Width => 2); Put(") / 7 = ");
|
||||
Put(Big_Integer'Image(D(P) / 7)); New_Line;
|
||||
end loop;
|
||||
end Arithmetic_Derivative;
|
||||
12
Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic
Normal file
12
Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
10 DEFINT A-Z
|
||||
20 FOR N=-99 TO 100
|
||||
30 GOSUB 100: PRINT USING "########";L;
|
||||
40 NEXT
|
||||
50 END
|
||||
100 L=0: F=3: Z=ABS(N)
|
||||
110 IF Z<2 THEN RETURN
|
||||
120 IF Z MOD 2=0 THEN L=L+N\2: Z=Z\2: GOTO 120
|
||||
130 IF F>Z THEN RETURN
|
||||
140 IF Z MOD F=0 THEN L=L+N\F: Z=Z\F: GOTO 140
|
||||
150 F=F+2
|
||||
160 GOTO 130
|
||||
44
Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu
Normal file
44
Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
factors = iter (n: bigint) yields (bigint)
|
||||
own zero: bigint := bigint$i2bi(0)
|
||||
own two: bigint := bigint$i2bi(2)
|
||||
own three: bigint := bigint$i2bi(3)
|
||||
|
||||
while n>zero cand n//two = zero do yield(two) n := n/two end
|
||||
|
||||
fac: bigint := three
|
||||
while fac<=n do
|
||||
while n//fac = zero do yield(fac) n := n/fac end
|
||||
fac := fac + two
|
||||
end
|
||||
end factors
|
||||
|
||||
lagarias = proc (n: bigint) returns (bigint)
|
||||
own zero: bigint := bigint$i2bi(0)
|
||||
if n < zero then return(-lagarias(-n)) end
|
||||
|
||||
sum: bigint := zero
|
||||
for fac: bigint in factors(n) do
|
||||
sum := sum + n / fac
|
||||
end
|
||||
return(sum)
|
||||
end lagarias
|
||||
|
||||
start_up = proc ()
|
||||
own po: stream := stream$primary_output()
|
||||
own seven: bigint := bigint$i2bi(7)
|
||||
own ten: bigint := bigint$i2bi(10)
|
||||
|
||||
for n: int in int$from_to(-99, 100) do
|
||||
stream$putright(po, bigint$unparse(lagarias(bigint$i2bi(n))), 7)
|
||||
if (n + 100)//10 = 0 then stream$putl(po, "") end
|
||||
end
|
||||
|
||||
for m: int in int$from_to(1, 20) do
|
||||
d: bigint := lagarias(ten ** bigint$i2bi(m)) / seven
|
||||
stream$puts(po, "D(10^")
|
||||
stream$putright(po, int$unparse(m), 2)
|
||||
stream$puts(po, ") / 7 = ")
|
||||
stream$putright(po, bigint$unparse(d), 25)
|
||||
stream$putl(po, "")
|
||||
end
|
||||
end start_up
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
include "cowgol.coh";
|
||||
|
||||
sub abs(n: int32): (r: uint32) is
|
||||
if n<0 then
|
||||
r := (-n) as uint32;
|
||||
else
|
||||
r := n as uint32;
|
||||
end if;
|
||||
end sub;
|
||||
|
||||
sub printcol(n: int32, s: uint8) is
|
||||
var buf: uint8[12];
|
||||
var ptr := IToA(n, 10, &buf[0]);
|
||||
s := s - (ptr - &buf[0]) as uint8;
|
||||
while s>0 loop
|
||||
print_char(' ');
|
||||
s := s-1;
|
||||
end loop;
|
||||
print(&buf[0]);
|
||||
end sub;
|
||||
|
||||
sub lagarias(n: int32): (r: int32) is
|
||||
var nn := abs(n);
|
||||
r := 0;
|
||||
if nn<2 then return; end if;
|
||||
var f: uint32 := 2;
|
||||
while f<=nn loop
|
||||
while nn%f == 0 loop
|
||||
r := r + n/f as int32;
|
||||
nn := nn/f;
|
||||
end loop;
|
||||
f := f+1;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
var i: int32 := -99;
|
||||
var c: uint8 := 0;
|
||||
while i <= 100 loop
|
||||
printcol(lagarias(i), 7);
|
||||
i := i+1;
|
||||
c := c+1;
|
||||
if c%10 == 0 then print_nl(); end if;
|
||||
end loop;
|
||||
32
Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco
Normal file
32
Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
proc lagarias(int n) int:
|
||||
int f, r, s;
|
||||
if n<0 then
|
||||
-lagarias(-n)
|
||||
elif n<2 then
|
||||
0
|
||||
else
|
||||
s := 0;
|
||||
r := n;
|
||||
while r % 2 = 0 do
|
||||
r := r / 2;
|
||||
s := s + n / 2
|
||||
od;
|
||||
f := 3;
|
||||
while f <= r do
|
||||
while r % f = 0 do
|
||||
r := r / f;
|
||||
s := s + n / f
|
||||
od;
|
||||
f := f + 2
|
||||
od;
|
||||
s
|
||||
fi
|
||||
corp
|
||||
|
||||
proc main() void:
|
||||
int n;
|
||||
for n from -99 upto 100 do
|
||||
write(lagarias(n):7);
|
||||
if (n+100) % 10=0 then writeln() fi
|
||||
od
|
||||
corp
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
Function aDerivative(Byval n As Longint) As Longint
|
||||
If n < 0 Then Return -aDerivative(-n)
|
||||
If n = 0 Or n = 1 Then Return 0
|
||||
If n = 2 Then Return 1
|
||||
|
||||
Dim As Longint q, d = 2
|
||||
Dim As Longint result = 1
|
||||
|
||||
While d * d <= n
|
||||
If n Mod d = 0 Then
|
||||
q = n \ d
|
||||
result = q * aDerivative(d) + d * aDerivative(q)
|
||||
Exit While
|
||||
End If
|
||||
d += 1
|
||||
Wend
|
||||
|
||||
Return result
|
||||
End Function
|
||||
|
||||
'Main program
|
||||
Print "Arithmetic derivatives for -99 through 100:"
|
||||
|
||||
Dim As Integer col, n
|
||||
col = 0
|
||||
For n = -99 To 100
|
||||
col += 1
|
||||
Print Using "####"; aDerivative(n);
|
||||
If col = 10 Then
|
||||
Print
|
||||
col = 0
|
||||
Else
|
||||
Print " ";
|
||||
End If
|
||||
Next
|
||||
|
||||
'Stretch task
|
||||
Print !"\n\nPowers of 10 derivatives divided by 7:"
|
||||
Dim As Double m = 1
|
||||
For n = 1 To 18 ' LongInt limit in FreeBASIC
|
||||
m *= 10
|
||||
Dim As Longint a = aDerivative(Clngint(m))
|
||||
Print Using "D(10^&) / 7 = &"; n; a \ 7
|
||||
Next
|
||||
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
// Arithmetic Derivative
|
||||
// https://rosettacode.org/wiki/Arithmetic_derivative#
|
||||
|
||||
local fn DoIt( N as short) as short
|
||||
short L,F,Z
|
||||
L = 0: F = 3: Z = ABS(N)
|
||||
IF Z<2 THEN exit fn
|
||||
|
||||
1 IF Z MOD 2 = 0 THEN L=L+N\2: Z=Z\2: GOTO 1
|
||||
2 IF F>Z THEN exit fn
|
||||
3 IF Z MOD F = 0 THEN L=L+N\F: Z=Z\F: GOTO 2
|
||||
|
||||
F=F+2
|
||||
goto 1
|
||||
|
||||
end fn = L
|
||||
|
||||
_Window = 1
|
||||
|
||||
window _Window,@"Arithmetic Derivative",fn cgrectmake(0,0,640,400)
|
||||
windowcenter(_Window)
|
||||
|
||||
short N,L,LineCount
|
||||
FOR N = -99 TO 100
|
||||
L = fn DoIt(N): PRINT USING "########";L;
|
||||
LineCount ++
|
||||
if LineCount = 10 then print : LineCount = 0
|
||||
NEXT
|
||||
|
||||
handleevents
|
||||
42
Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad
Normal file
42
Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
NORMAL MODE IS INTEGER
|
||||
|
||||
INTERNAL FUNCTION(X,Y)
|
||||
ENTRY TO REM.
|
||||
FUNCTION RETURN X-(X/Y)*Y
|
||||
END OF FUNCTION
|
||||
|
||||
INTERNAL FUNCTION(N)
|
||||
ENTRY TO DERIV.
|
||||
R = N
|
||||
WHENEVER R.L.0, R = -R
|
||||
WHENEVER R.L.2, FUNCTION RETURN 0
|
||||
S = 0
|
||||
FAC2 WHENEVER REM.(R,2).E.0
|
||||
S = S + N/2
|
||||
R = R/2
|
||||
TRANSFER TO FAC2
|
||||
END OF CONDITIONAL
|
||||
THROUGH FAC, FOR F=3, 2, F.G.R
|
||||
FACF WHENEVER REM.(R,F).E.0
|
||||
S = S + N/F
|
||||
R = R/F
|
||||
TRANSFER TO FACF
|
||||
END OF CONDITIONAL
|
||||
FAC CONTINUE
|
||||
FUNCTION RETURN S
|
||||
END OF FUNCTION
|
||||
|
||||
VECTOR VALUES LINEF = $10(I6)*$
|
||||
DIMENSION LINE(10)
|
||||
C = 0
|
||||
THROUGH ITEM, FOR I=-99, 1, I.G.100
|
||||
LINE(C) = DERIV.(I)
|
||||
C = C+1
|
||||
WHENEVER C.E.10
|
||||
PRINT FORMAT LINEF,
|
||||
0 LINE(0),LINE(1),LINE(2),LINE(3),LINE(4),
|
||||
1 LINE(5),LINE(6),LINE(7),LINE(8),LINE(9)
|
||||
C = 0
|
||||
END OF CONDITIONAL
|
||||
ITEM CONTINUE
|
||||
END OF PROGRAM
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue