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

Time for an 2014 update…

Browse source
This commit is contained in:
Ingy döt Net 2014-01-17 05:32:22 +00:00
parent 372c577f83
commit 09687c4926
2520 changed files with 34227 additions and 7318 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Task/100-doors/C-sharp/100-doors-5.cs Normal file
View file

@ -0,0 +1,14 @@
class Program
{
static void Main(string[] args)
{
bool[] doorStates = new bool[100];
int n = 0;
int d;
while ((d = (++n * n)) <= 100)
doorStates[d - 1] = true;
for (int i = 0; i < doorStates.Length; i++)
Console.WriteLine("Door {0}: {1}", i + 1, doorStates[i] ? "Open" : "Closed");
Console.ReadKey(true);
}
}

4
Task/100-doors/C/100-doors-1.c
View file

@ -5,12 +5,12 @@ int main()
char is_open[100] = { 0 };
int pass, door;
// do the 100 passes
/* do the 100 passes */
for (pass = 0; pass < 100; ++pass)
for (door = pass; door < 100; door += pass+1)
is_open[door] = !is_open[door];
// output the result
/* output the result */
for (door = 0; door < 100; ++door)
printf("door #%d is %s.\n", door+1, (is_open[door]? "open" : "closed"));

29
Task/100-doors/C/100-doors-2.c
View file

@ -1,19 +1,22 @@
#include <stdio.h>
int main()
#define NUM_DOORS 100
int main(int argc, char *argv[])
{
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;
int is_open[NUM_DOORS] = { 0 } ;
int * doorptr, * doorlimit = is_open + NUM_DOORS ;
int pass ;
/* do the N passes, go backwards because the order is not important */
for ( pass= NUM_DOORS ; ( pass ) ; -- pass ) {
for ( doorptr= is_open + ( pass-1 ); ( doorptr < doorlimit ) ; doorptr += pass ) {
( * doorptr ) ^= 1 ;
}
else
printf(" is closed.\n");
}
return 0;
/* output results */
for ( doorptr= is_open ; ( doorptr != doorlimit ) ; ++ doorptr ) {
printf("door #%ld is %s\n", ( doorptr - is_open ) + 1, ( * doorptr ) ? "open" : "closed" ) ;
}
}

16
Task/100-doors/C/100-doors-3.c
View file

@ -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;
}

9
Task/100-doors/C/100-doors-4.c
View file

@ -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-5.c Normal file
View 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;
}

9
Task/100-doors/COBOL/100-doors.cobol
View file

@ -3,7 +3,7 @@
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Current PIC 9(3).
01 Current-n PIC 9(3).
01 StepSize PIC 9(3).
01 DoorTable.
02 Doors PIC 9(1) OCCURS 100 TIMES.
@ -12,10 +12,11 @@
PROCEDURE DIVISION.
Begin.
INITIALIZE DoorTable
PERFORM VARYING StepSize FROM 1 BY 1 UNTIL StepSize > 100
PERFORM VARYING Current FROM StepSize BY StepSize
UNTIL Current > 100
SUBTRACT Doors (Current) FROM 1 GIVING Doors (Current)
PERFORM VARYING Current-n FROM StepSize BY StepSize
UNTIL Current-n > 100
SUBTRACT Doors (Current-n) FROM 1 GIVING Doors (Current-n)
END-PERFORM
END-PERFORM

12
Task/100-doors/Deja-Vu/100-doors.djv Normal file
View file

@ -0,0 +1,12 @@
local :open-doors [ rep 101 false ]
for i range 1 100:
local :j i
while <= j 100:
set-to open-doors j not open-doors! j
set :j + j i
!print\ "Open doors: "
for i range 1 100:
if open-doors! i:
!print\( to-str i " " )

32
Task/100-doors/GML/100-doors.gml
View file

@ -1,28 +1,30 @@
var doors,a,i;
//Sets up the array for all of the doors.
for (i=1;i<=100;i+=1)
for (i = 1; i<=100; i += 1)
{
doors[i]=0;
doors[i]=0;
}
//This first for loop goes through and passes the interval down to the next for loop.
for (i=1;i<=100;i+=1)
for (i = 1; i <= 100; i += 1;)
{
//This for loop opens or closes the doors and uses the interval(if interval is 2 it only uses every other etc..)
for (a=0;a<=100;a+=i;)
{
//Opens or closes a door.
doors[a]=!doors[a];
}
//This for loop opens or closes the doors and uses the interval(if interval is 2 it only uses every other etc..)
for (a = 0; a <= 100; a += i;)
{
//Opens or closes a door.
doors[a] = !doors[a];
}
}
open_doors='';
open_doors = '';
//This for loop goes through the array and checks for open doors.
//If the door is open it adds it to the string then displays the string.
for (i=1;i<=100;i+=1)
for (i = 1; i <= 100; i += 1;)
{
if doors[i]=1
{
open_doors+="Door Number "+string(i)+" is open#";
}
if (doors[i] == 1)
{
open_doors += "Door Number "+string(i)+" is open#";
}
}
show_message(open_doors);
game_end();

2
Task/100-doors/Io/100-doors.io → Task/100-doors/Io/100-doors-1.io
View file

@ -1,5 +1,5 @@
doors := List clone
for(i,1,100, doors append(false))
100 repeat(doors append(false))
for(i,1,100,
for(x,i,100, i, doors atPut(x - 1, doors at(x - 1) not))
)

1
Task/100-doors/Io/100-doors-2.io Normal file
View file

@ -0,0 +1 @@
(Range 1 to(10) asList) foreach(v, "Door #{v ** 2} is open." interpolate println)

8
Task/100-doors/Ruby/100-doors-2.rb
View file

@ -9,10 +9,10 @@ def Closed.toggle
end
doors = [Closed] * (n + 1)
for mul in 1..n
for x in 1..n / mul
doors[mul * x] = doors[mul * x].toggle
for x in (mul..n).step(mul)
doors[x] = doors[x].toggle
end
end
doors.each_with_index { |b, i|
doors.each_with_index do |b, i|
puts "Door #{i} is #{b}" if i > 0
}
end

2
Task/100-doors/Ruby/100-doors-4.rb
View file

@ -4,4 +4,4 @@ doors = [false] * 100
doors[j] = !doors[j]
end
end
puts doors.map.with_index{|d, i| "Door #{i+1} is #{d ? 'open' : 'closed'}."}
puts doors.map.with_index(1){|d,i| "Door #{i} is #{d ? 'open' : 'closed'}."}

13
Task/100-doors/VBA/100-doors.vba Normal file
View file

@ -0,0 +1,13 @@
Sub Rosetta_100Doors()
Dim Door(100) As Boolean, i As Integer, j As Integer
For i = 1 To 100 Step 1
For j = i To 100 Step i
Door(j) = Not Door(j)
Next j
If Door(i) = True Then
Debug.Print "Door " & i & " is Open"
Else
Debug.Print "Door " & i & " is Closed"
End If
Next i
End Sub

2
Task/24-game-Solve/C/24-game-solve.c
View file

@ -7,7 +7,7 @@
#define max_digit 9
typedef struct { int num, denom; } frac_t, *frac;
typedef enum { C_NUM = 0, C_ADD, C_SUB, C_MUL, C_DIV, } op_type;
typedef enum { C_NUM = 0, C_ADD, C_SUB, C_MUL, C_DIV } op_type;
typedef struct expr_t *expr;
typedef struct expr_t {

2
Task/24-game-Solve/PicoLisp/24-game-solve.l
View file

@ -6,7 +6,7 @@
(or
((equal @Expr (@Op1 (@Op2 @A @B) (@Op3 @C @D))))
((equal @Expr (@Op1 @A (@Op2 @B (@Op3 @C @D))))) )
(@ = 24 (catch '("Div/0") (eval (-> @Expr)))) )
(^ @ (= 24 (catch '("Div/0") (eval (-> @Expr))))) )
(de play24 (A B C D) # Define PicoLisp function
(pilog

2
Task/24-game/00DESCRIPTION
View file

@ -1,6 +1,6 @@
The [[wp:24 Game|24 Game]] tests one's mental arithmetic.
Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an equation using ''just'' those, and ''all'' of those four digits. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]]. The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that evaluates to '''24'''.
Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]]. The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that evaluates to '''24'''.
* Only multiplication, division, addition, and subtraction operators/functions are allowed.
* Division should use floating point or rational arithmetic, etc, to preserve remainders.
* Brackets are allowed, if using an infix expression evaluator.

9
Task/24-game/C/24-game.c
View file

@ -1,9 +1,10 @@
#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <ucontext.h>
#include <setjmp.h>
#include <time.h>
ucontext_t ctx;
jmp_buf ctx;
const char *msg;
enum { OP_NONE = 0, OP_NUM, OP_ADD, OP_SUB, OP_MUL, OP_DIV };
@ -49,7 +50,7 @@ void reset()
void bail(const char *s)
{
msg = s;
setcontext(&ctx);
longjmp(ctx, 1);
}
expr new_expr()
@ -256,7 +257,7 @@ int main()
gen_digits();
while(1) {
get_input();
getcontext(&ctx); /* if parse error, jump back here with err msg set */
setjmp(ctx); /* if parse error, jump back here with err msg set */
if (msg) {
/* after error jump; announce, reset, redo */
printf("%s at '%.*s'\n", msg, pos, str);

0
Task/24-game/Fortran/24-game.f → Task/24-game/Fortran/24-game-1.f
View file

210
Task/24-game/Fortran/24-game-2.f Normal file
View file

@ -0,0 +1,210 @@
! implement a recursive descent parser
module evaluate_algebraic_expression
integer, parameter :: size = 124
character, parameter :: statement_end = achar(0)
character(len=size) :: text_to_parse
integer :: position
data position/0/,text_to_parse/' '/
contains
character function get_token()
! return the current token
implicit none
if (position <= size) then
get_token = text_to_parse(position:position)
do while (get_token <= ' ')
call advance
if (size < position) exit
get_token = text_to_parse(position:position)
end do
end if
if (size < position) get_token = statement_end
end function get_token
subroutine advance ! consume a token. Move to the next token. consume_token would have been a better name.
position = position + 1
end subroutine advance
logical function unfinished()
unfinished = get_token() /= statement_end
end function unfinished
subroutine parse_error()
write(6,*)'"'//get_token()//'" unexpected in expression at',position
stop 1
end subroutine parse_error
function precedence3() result(a)
implicit none
real :: a
character :: token
character(len=10), parameter :: digits = '0123456789'
token = get_token()
if (verify(token,digits) /= 0) call parse_error()
a = index(digits, token) - 1
call advance()
end function precedence3
recursive function precedence2() result(a)
real :: a
character :: token
token = get_token()
if (token /= '(') then
a = precedence3()
else
call advance
a = precedence0()
token = get_token()
if (token /= ')') call parse_error()
call advance
end if
end function precedence2
recursive function precedence1() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '*/'
character :: token
a = 0
token = get_token()
argument(1) = precedence2()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence2()
if (token == '/') argument(2) = 1 / argument(2)
argument(1) = product(argument)
token = get_token()
end do
a = argument(1)
end function precedence1
recursive function precedence0() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '+-'
character :: token
a = 0
token = get_token()
argument(1) = precedence1()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence1()
if (token == '-') argument = argument * (/1, -1/)
argument(1) = sum(argument)
token = get_token()
end do
a = argument(1)
end function precedence0
real function statement()
implicit none
if (unfinished()) then
statement = precedence0()
else !empty okay
statement = 0
end if
if (unfinished()) call parse_error()
end function statement
real function evaluate(expression)
implicit none
character(len=*), intent(in) :: expression
text_to_parse = expression
evaluate = statement()
end function evaluate
end module evaluate_algebraic_expression
program g24
use evaluate_algebraic_expression
implicit none
integer, dimension(4) :: digits
character(len=78) :: expression
real :: result
! integer :: i
call random_seed!easily found internet examples exist to seed by /dev/urandom or time
call deal(digits)
! do i=1, 9999 ! produce the data to test digit distribution
! call deal(digits)
! write(6,*) digits
! end do
write(6,'(a13,4i2,a26)')'Using digits',digits,', and the algebraic dyadic'
write(6,*)'operators +-*/() enter an expression computing 24.'
expression = ' '
read(5,'(a78)') expression
if (invalid_digits(expression, digits)) then
write(6,*)'invalid digits'
else
result = evaluate(expression)
if (nint(result) == 24) then
write(6,*) result, ' close enough'
else
write(6,*) result, ' no good'
end if
end if
contains
logical function invalid_digits(e,d) !verify the digits
implicit none
character(len=*), intent(in) :: e
integer, dimension(4), intent(inout) :: d
integer :: i, j, k, count
logical :: unfound
count = 0
invalid_digits = .false. !validity assumed
!write(6,*)'expression:',e(1:len_trim(e))
do i=1, len_trim(e)
if (verify(e(i:i),'0123456789') == 0) then
j = index('0123456789',e(i:i))-1
unfound = .true.
do k=1, 4
if (j == d(k)) then
unfound = .false.
exit
end if
end do
if (unfound) then
invalid_digits = .true.
!return or exit is okay here
else
d(k) = -99
count = count + 1
end if
end if
end do
invalid_digits = invalid_digits .or. (count /= 4)
end function invalid_digits
subroutine deal(digits)
implicit none
integer, dimension(4), intent(out) :: digits
integer :: i
real :: harvest
call random_number(harvest)
do i=1, 4
digits(i) = int(mod(harvest*9**i, 9.0)) + 1
end do
! NB. computed with executable Iverson notation, www.jsoftware.oom
! #B NB. B are the digits from 9999 deals
! 39996
! ({.,#)/.~/:~B # show the distribution of digits
! 0 4380
! 1 4542
! 2 4348
! 3 4395
! 4 4451
! 5 4474
! 6 4467
! 7 4413
! 8 4526
! NB. this also shows that I forgot to add 1. Inserting now...
end subroutine deal
end program g24

142
Task/24-game/REXX/24-game-1.rexx
View file

@ -33,116 +33,105 @@ Rpar=')' /*ditto. */
show=1 /*flag used show solutions (0 = not). */
digs=123456789 /*numerals (digits) that can be used. */
do j=1 for ops /*define a version for fast execution. */
do j=1 for ops /*define a version for fast execution. */
o.j=substr(opers,j,1)
end /*j*/
if orig\=='' then do
sols=solve(start,finish)
if sols<0 then exit 13
if sols==0 then sols='No' /*un-geek SOLS.*/
say
say sols 'unique solution's(finds) "found for" orig /*pluralize.*/
exit
if sols<0 then exit 13
if sols==0 then sols='No' /*un-geek the SOLS var.*/
say; say sols 'unique solution's(finds) "found for" orig
exit /* [↑] "S" pluralizes.*/
end
show=0 /*stop SOLVE from blabbing solutions. */
do forever
do forever
rrrr=random(1111,9999)
if pos(0,rrrr)\==0 then iterate
if solve(rrrr)\==0 then leave
end
if pos(0,rrrr)\==0 then iterate
if solve(rrrr)\==0 then leave
end /*forever*/
show=1 /*enable SOLVE to show solutions. */
rrrr=sort(rrrr) /*sort four elements. */
rd.=0
do j=1 for 9 /*digit count # for each digit in RRRR.*/
do j=1 for 9 /*digit count # for each digit in RRRR.*/
_=substr(rrrr,j,1)
rd._=countdigs(rrrr,_)
end /*j*/
do guesses=1; say
say 'Using the digits',
rrrr", enter an expression that equals 24 (or QUIT):"
pull y
y=space(y,0); if y=='QUIT' then exit
_v=verify(y,digs||opers||groupsymbols)
if _v\==0 then do
call ger 'invalid character:' substr(_v,1)
iterate
end
yl=length(y)
if y='' then do
call validate y
iterate
end
say 'Using the digits' rrrr", enter an expression that equals 24 (or QUIT):"
pull y; y=space(y,0) /*get Y from CL, then remove all blanks*/
if y=='QUIT' then exit /*Does user want to quit? If so, exit.*/
_v=verify(y, digs || opers || groupsymbols); __=substr(y, _v, 1)
if _v\==0 then do; call ger 'invalid character:' __; iterate; end
if pos('**',y) then do; call ger 'invalid ** operator'; iterate; end
if pos('//',y) then do; call ger 'invalid // operator'; iterate; end
yL=length(y)
if y=='' then do; call validate y; iterate; end
do j=1 to yl-1
_=substr(y,j,1)
if \datatype(_,'W') then iterate
_=substr(y,j+1,1)
if datatype(_,'W') then do
call ger 'invalid use of digit abuttal'
iterate guesses
end
do j=1 for yL-1; if \datatype(substr(y, j , 1), 'W') then iterate
if \datatype(substr(y, j+1, 1), 'W') then iterate
call ger 'invalid use of digit abuttal'
iterate guesses
end /*j*/
yd=countdigs(y,digs) /*count of digits 123456789.*/
if yd<4 then do
call ger 'not enough digits entered.'
iterate guesses
end
if yd>4 then do
call ger 'too many digits entered.'
iterate guesses
end
if yd<4 then do
call ger 'not enough digits entered.'
iterate guesses
end
if yd>4 then do
call ger 'too many digits entered.'
iterate guesses
end
do j=1 for 9; if rd.j==0 then iterate
do j=1 for 9; if rd.j==0 then iterate
_d=countdigs(y,j)
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "digits, must be" rd.j
else call ger 'too many' j "digits, must be" rd.j
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "digits, must be" rd.j
else call ger 'too many' j "digits, must be" rd.j
iterate guesses
end /*j*/
y=translate(y,'()()',"[]{}")
signal on syntax
interpret 'ans='y
ans=ans/1
if ans==24 then leave guesses
interpret 'ans='y; ans=ans/1
if ans==24 then leave guesses
say 'incorrect,' y'='ans
end /*guesses*/
say
say center('┌─────────────────────┐',79)
say center('│ │',79)
say center('│ congratulations ! │',79)
say center('│ │',79)
say center('└─────────────────────┘',79)
say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79)
exit
/*───────────────────────────SOLVE subroutine───────────────────────────*/
solve: parse arg ssss,ffff /*parse the argument passed to SOLVE. */
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
if \validate(ssss) then return -1
if \validate(ffff) then return -1
finds=0 /*number of found solutions (so far). */
x.=0 /*a method to hold unique expressions. */
/*alternative: indent=copies(' ',30) */
do g=ssss to ffff /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do g=ssss to ffff /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do j=1 for 4 /*define a version for fast execution. */
do j=1 for 4 /*define a version for fast execution. */
g.j=substr(g,j,1)
end /*j*/
do i=1 for ops /*insert an operator after 1st number. */
do j=1 for ops /*insert an operator after 2nd number. */
do k=1 for ops /*insert an operator after 2nd number. */
do m=0 to 4-1; L.="" /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
do i =1 for ops /*insert an operator after 1st number. */
do j =1 for ops /*insert an operator after 2nd number. */
do k =1 for ops /*insert an operator after 2nd number. */
do m=0 to 4-1; L.="" /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
L.m=Lpar /*define a left paren, m=0 means ignore*/
R.="" /*un-define all right parenthesis. */
if m==1 & n==2 then L.="" /*special case: (n)+ ... */
else if m\==0 then R.n=Rpar /*no (, no )*/
if m==1 & n==2 then L.="" /*special case: (n)+ ... */
else if m\==0 then R.n=Rpar /*no (, no )*/
e = L.1 g.1 o.i L.2 g.2 o.j L.3 g.3 R.3 o.k g.4 R.4
e=space(e,0) /*remove all blanks from the expression*/
@ -150,21 +139,21 @@ x.=0 /*a method to hold unique expressions. */
/* /(yyy) ===> /div(yyy) */
/*Enables to check for division by zero*/
origE=e /*keep old version for the display. */
if pos('/(',e)\==0 then e=changestr('/(',e,"/div(")
if pos('/(',e)\==0 then e=changestr('/(',e,"/div(")
/*The above could be replaced by: */
/* e=changestr('/(',e,"/div(") */
/*INTERPRET stresses REXX's groin, */
/*so try to avoid repeated lifting. */
if x.e then iterate /*was the expression already used? */
if x.e then iterate /*was the expression already used? */
x.e=1 /*mark this expression as unique. */
/*have REXX do the heavy lifting. */
interpret 'x=' e
x=x/1 /*remove trailing decimal points. */
if x\==24 then iterate /*Not correct? Try again.*/
if x\==24 then iterate /*Not correct? Try again.*/
finds=finds+1 /*bump number of found solutions. */
_=translate(origE,'][',")(") /*show [], not ().*/
if show then say indent 'a solution:' _ /*show solution*/
_=translate(origE, '][', ")(") /*show [], not ().*/
if show then say indent 'a solution:' _ /*show solution.*/
end /*n*/
end /*m*/
end /*k*/
@ -173,27 +162,30 @@ x.=0 /*a method to hold unique expressions. */
end /*g*/
return finds
/*───────────────────────────CHANGESTR subroutine───────────────────────*/
changestr: procedure; parse arg o,h,n,,r; w=length(o); if w==0 then return n||h
do forever; parse var h y (o) _ +(w) h; if _=='' then return r||y; r=r||y||n; end
/*───────────────────────────COUNTDIGS subroutine───────────────────────*/
countdigs: arg field,numerals /*count of digits NUMERALS.*/
return length(field)-length(space(translate(field,,numerals),0))
/*───────────────────────────DIV subroutine─────────────────────────────*/
div: procedure; parse arg q /*tests if dividing by 0 (zero). */
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
return q /*changing Q invalidates the expression*/
/*───────────────────────────GER subroutine─────────────────────────────*/
ger: say; say '*** error! *** for argument:' y; say arg(1); say; errCode=1; return 0
/*───────────────────────────S subroutine───────────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
/*───────────────────────────SORT subroutine────────────────────────────*/
sort: procedure; arg nnnn; L=length(nnnn)
do i=1 for L /*build an array of digits from NNNN.*/
do i=1 for L /*build an array of digits from NNNN.*/
a.i=substr(nnnn,i,1) /*this enables SORT to sort an array. */
end /*i*/
do j=1 for L; _=a.j
do k=j+1 to L
if a.k<_ then parse value a.j a.k with a.k a.j
do j=1 for L; _=a.j
do k=j+1 to L
if a.k<_ then parse value a.j a.k with a.k a.j
end /*k*/
end /*j*/
return a.1 || a.2 || a.3 || a.4

122
Task/24-game/VBA/24-game.vba Normal file
View file

@ -0,0 +1,122 @@
Sub Rosetta_24game()
Dim Digit(4) As Integer, i As Integer, iDigitCount As Integer
Dim stUserExpression As String
Dim stFailMessage As String, stFailDigits As String
Dim bValidExpression As Boolean, bValidDigits As Boolean, bValidChars As Boolean
Dim vResult As Variant, vTryAgain As Variant, vSameDigits As Variant
' Generate 4 random digits
GenerateNewDigits:
For i = 1 To 4
Digit(i) = [randbetween(1,9)]
Next i
' Get user expression
GetUserExpression:
bValidExpression = True
stFailMessage = ""
stFailDigits = ""
stUserExpression = InputBox("Enter a mathematical expression which results in 24, using the following digits: " & _
Digit(1) & ", " & Digit(2) & ", " & Digit(3) & " and " & Digit(4), "Rosetta Code | 24 Game")
' Check each digit is included in user expression
bValidDigits = True
stFailDigits = ""
For i = 1 To 4
If InStr(stUserExpression, Digit(i)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Digit(i)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = "Your expression excluded the following required digits: " & stFailDigits & vbCr & vbCr
End If
' Check each character of user expression is a valid character type
bValidDigits = True
stFailDigits = ""
For i = 1 To Len(stUserExpression)
If InStr("0123456789+-*/()", Mid(stUserExpression, i, 1)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid characters:" & stFailDigits & vbCr & vbCr
End If
' Check no disallowed integers entered
bValidDigits = True
stFailDigits = ""
iDigitCount = 0
For i = 1 To Len(stUserExpression)
If Not InStr("0123456789", Mid(stUserExpression, i, 1)) = 0 Then
iDigitCount = iDigitCount + 1
If IsError(Application.Match(--(Mid(stUserExpression, i, 1)), Digit, False)) Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
End If
Next i
If iDigitCount > 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained more than 4 digits" & vbCr & vbCr
End If
If iDigitCount < 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained less than 4 digits" & vbCr & vbCr
End If
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid digits:" & stFailDigits & vbCr & vbCr
End If
' Check no double digit numbers entered
bValidDigits = True
stFailDigits = ""
For i = 11 To 99
If Not InStr(stUserExpression, i) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & i
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid numbers:" & stFailDigits & vbCr & vbCr
End If
' Check result of user expression
On Error GoTo EvalFail
vResult = Evaluate(stUserExpression)
If Not vResult = 24 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression did not result in 24. It returned: " & vResult
End If
' Return results
If bValidExpression = False Then
vTryAgain = MsgBox(stFailMessage & vbCr & vbCr & "Would you like to try again?", vbCritical + vbRetryCancel, "Rosetta Code | 24 Game | FAILED")
If vTryAgain = vbRetry Then
vSameDigits = MsgBox("Do you want to use the same numbers?", vbQuestion + vbYesNo, "Rosetta Code | 24 Game | RETRY")
If vSameDigits = vbYes Then
GoTo GetUserExpression
Else
GoTo GenerateNewDigits
End If
End If
Else
vTryAgain = MsgBox("You entered: " & stUserExpression & vbCr & vbCr & "which resulted in: " & vResult, _
vbInformation + vbRetryCancel, "Rosetta Code | 24 Game | SUCCESS")
If vTryAgain = vbRetry Then
GoTo GenerateNewDigits
End If
End If
Exit Sub
EvalFail:
bValidExpression = False
vResult = Err.Description
Resume
End Sub

13
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-10.basic Normal file
View file

@ -0,0 +1,13 @@
For bottles = 99 To 1 Step -1
song$ = song$ + str$(bottles) + " bottle"
If (bottles > 1) Then song$ = song$ + "s"
song$ = song$ + " of beer on the wall, " + str$(bottles) + " bottle"
If (bottles > 1) Then song$ = song$ + "s"
song$ = song$ + " of beer," + chr$(13) + chr$(10) + "Take one down, pass it around, " + str$(bottles - 1) + " bottle"
If (bottles > 2) Or (bottles = 1) Then song$ = song$ + "s"
song$ = song$ + " of beer on the wall." + chr$(13) + chr$(10)
Next bottles
song$ = song$ + "No more bottles of beer on the wall, no more bottles of beer." _
+ chr$(13) + chr$(10) + "Go to the store and buy some more, 99 bottles of beer on the wall."
Print song$

13
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-11.basic Normal file
View file

@ -0,0 +1,13 @@
If OpenConsole()
Define Bottles=99
While Bottles
PrintN(Str(Bottles)+" bottles of beer on the wall")
PrintN(Str(Bottles)+" bottles of beer")
PrintN("Take one down, pass it around")
Bottles-1
PrintN(Str(Bottles)+" bottles of beer on the wall"+#CRLF$)
Wend
PrintN(#CRLF$+#CRLF$+"Press ENTER to exit"):Input()
CloseConsole()
EndIf

59
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-12.basic Normal file
View file

@ -0,0 +1,59 @@
Prototype Wall_Action(*Self, Number.i)
Structure WallClass
Inventory.i
AddBottle.Wall_Action
DrinkAndSing.Wall_Action
EndStructure
Procedure.s _B(n, Short=#False)
Select n
Case 0 : result$="No more bottles "
Case 1 : result$=Str(n)+" bottle of beer"
Default: result$=Str(n)+" bottles of beer"
EndSelect
If Not Short: result$+" on the wall": EndIf
ProcedureReturn result$+#CRLF$
EndProcedure
Procedure PrintBottles(*Self.WallClass, n)
Bottles$=" bottles of beer "
Bottle$ =" bottle of beer "
txt$ = _B(*Self\Inventory)
txt$ + _B(*Self\Inventory, #True)
txt$ + "Take one down, pass it around"+#CRLF$
*Self\AddBottle(*Self, -1)
txt$ + _B(*self\Inventory)
PrintN(txt$)
ProcedureReturn *Self\Inventory
EndProcedure
Procedure AddBottle(*Self.WallClass, n)
i=*Self\Inventory+n
If i>=0
*Self\Inventory=i
EndIf
EndProcedure
Procedure InitClass()
*class.WallClass=AllocateMemory(SizeOf(WallClass))
If *class
InitializeStructure(*class, WallClass)
With *class
\AddBottle =@AddBottle()
\DrinkAndSing =@PrintBottles()
EndWith
EndIf
ProcedureReturn *class
EndProcedure
If OpenConsole()
*MyWall.WallClass=InitClass()
If *MyWall
*MyWall\AddBottle(*MyWall, 99)
While *MyWall\DrinkAndSing(*MyWall, #True): Wend
;
PrintN(#CRLF$+#CRLF$+"Press ENTER to exit"):Input()
CloseConsole()
EndIf
EndIf

8
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-13.basic Normal file
View file

@ -0,0 +1,8 @@
dim bottles as Integer = 99
While bottles > 0
Print(str(bottles) + " bottles of beer on the wall")
Print(str(bottles) + " bottles of beer")
Print("Take one down, pass it around")
bottles = bottles - 1
Print(str(bottles) + " bottles of beer on the wall")
Wend

12
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-14.basic Normal file
View file

@ -0,0 +1,12 @@
b$ = " bottles"
for bottles = 99 To 1 Step -1
If (bottles = 1) then b$ = " bottle"
print bottles;b$;" of beer on the wall, "
print bottles ;b$;" of beer"
print "Take one down, pass it around, "
if bottles = 1 then
print "No bottles of beer on the wall"
else
print bottles - 1;b$;" of beer on the wall.";chr$(10)
end if
next bottles

13
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-15.basic Normal file
View file

@ -0,0 +1,13 @@
PROGRAM:BEER
:For(I,99,1,-1)
:Disp I
:Disp "BOTTLES OF BEER"
:Disp "ON THE WALL,"
:Disp I
:Pause "BOTTLES OF BEER,"
:Disp "TAKE ONE DOWN,"
:Disp "PASS IT AROUND,"
:Disp I-1
:Disp "BOTTLES OF BEER"
:Disp "ON THE WALL."
:End

47
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-16.basic Normal file
View file

@ -0,0 +1,47 @@
Prgm
Local i,plural,clockWas,t,k,wait
"s" → plural
0 → k
isClkOn() → clockWas
Define wait() = Prgm
EndPrgm
ClockOn
For i,99,0,–1
Disp ""
Disp string(i) & " bottle" & plural & " of beer on the"
Disp "wall, " & string(i) & " bottle" & plural & " of beer."
getTime()[3]→t
While getTime()[3] = t and k = 0 : getKey() → k : EndWhile
If k ≠ 0 Then : Exit : EndIf
Disp "Take one down, pass it"
Disp "around."
getTime()[3]→t
While getTime()[3] = t and k = 0 : getKey() → k : EndWhile
If k ≠ 0 Then : Exit : EndIf
If i - 1 = 1 Then
"" → plural
EndIf
If i > 1 Then
Disp string(i-1) & " bottle" & plural & " of beer on the"
Disp "wall."
Else
Disp "No more bottles of beer on"
Disp "the wall."
EndIf
getTime()[3]→t
While abs(getTime()[3] - t)<2 and k = 0 : getKey() → k : EndWhile
If k ≠ 0 Then : Exit : EndIf
EndFor
If not clockWas Then
ClockOff
ENdIf
EndPrgm

33
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-17.basic Normal file
View file

@ -0,0 +1,33 @@
Sub Main()
Const bottlesofbeer As String = " bottles of beer"
Const onthewall As String = " on the wall"
Const takeonedown As String = "Take one down, pass it around"
Const onebeer As String = "1 bottle of beer"
Dim bottles As Long
For bottles = 99 To 3 Step -1
Debug.Print CStr(bottles) & bottlesofbeer & onthewall
Debug.Print CStr(bottles) & bottlesofbeer
Debug.Print takeonedown
Debug.Print CStr(bottles - 1) & bottlesofbeer & onthewall
Debug.Print
Next
Debug.Print "2" & bottlesofbeer & onthewall
Debug.Print "2" & bottlesofbeer
Debug.Print takeonedown
Debug.Print onebeer & onthewall
Debug.Print
Debug.Print onebeer & onthewall
Debug.Print onebeer
Debug.Print takeonedown
Debug.Print "No more" & bottlesofbeer & onthewall
Debug.Print
Debug.Print "No" & bottlesofbeer & onthewall
Debug.Print "No" & bottlesofbeer
Debug.Print "Go to the store, buy some more"
Debug.Print "99" & bottlesofbeer & onthewall
End Sub

20
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-18.basic Normal file
View file

@ -0,0 +1,20 @@
Module Module1
Sub Main()
Dim Bottles As Integer
For Bottles = 99 To 0 Step -1
If Bottles = 0 Then
Console.WriteLine("No more bottles of beer on the wall, no more bottles of beer.")
Console.WriteLine("Go to the store and buy some more, 99 bottles of beer on the wall.")
Console.ReadLine()
ElseIf Bottles = 1 Then
Console.WriteLine(Bottles & " bottle of beer on the wall, " & Bottles & " bottle of beer.")
Console.WriteLine("Take one down and pass it around, no more bottles of beer on the wall.")
Console.ReadLine()
Else
Console.WriteLine(Bottles & " bottles of beer on the wall, " & Bottles & " bottles of beer.")
Console.WriteLine("Take one down and pass it around, " & (Bottles - 1) & " bottles of beer on the wall.")
Console.ReadLine()
End If
Next
End Sub
End Module

7
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-3.basic Normal file
View file

@ -0,0 +1,7 @@
10 HOME
20 FOR B=99 TO 1 STEP -1
30 PRINT B;" BOTTLE OF BEER ON THE WALL"
40 PRINT B;" BOTTLE OF BEER ON THE WALL"
50 PRINT "TAKE ONE DOWN, PASS IT AROUND"
60 PRINT B-1;" BOTTLE OF BEER ON THE WALL"
70 NEXT B

33
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-4.basic Normal file
View file

@ -0,0 +1,33 @@
#length of querter and eight note in ms
n4 = 1000 * 60 / 80 / 4
n8 = n4 / 2
#frequency of musical notes in hz
e = 330
ef = 311
b = 247
bf = 233
f = 349
c = 262
d = 294
ds = 311
a = 220
dim notes(1)
dim lengs(1)
# redim is automatic when using a {} list to assign an array
notes = {ef, ef, ef, bf, bf, bf, ef, ef, ef, ef, f , f , f , c , c , c , f , d , d , d , d , d , d , d , bf, bf, bf, c , c , ef, ef, ef, ef, ef}
lengs = {n8, n8, n8, n8, n8, n8, n8, n8, n8, n4, n8, n8, n8, n8, n8, n8, n4, n4, n8, n8, n8, n8, n8, n4, n8, n8, n8, n8, n8, n8, n8, n8, n8, n4 }
for x = 99 to 1 step -1
for t = 0 to notes[?]-1
if t = 0 then print x + " bottles of beer on the wall"
if t = 11 then print x + " bottles of beer"
if t = 18 then print "Take one down, pass it around"
if t = 25 then print(x-1) + " bottles of beer on the wall"
sound notes[t], lengs[t]
pause .002
next t
print
next x

32
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-5.basic Normal file
View file

@ -0,0 +1,32 @@
N_Bottles = 99
beer$ = " of beer"
wall$ = " on the wall"
unit$ = "99 bottles"
WHILE N_Bottles >= 0
IF N_Bottles=0 THEN
PRINT '"No more bottles" beer$ wall$ ", " unit$ beer$ "."
PRINT "Go to the store and buy some more, ";
ELSE
PRINT 'unit$ beer$ wall$ ", " unit$ beer$ "."
PRINT "Take one down and pass it around, ";
ENDIF
N_Bottles -= 1
CASE N_Bottles OF
WHEN 0:
unit$ = "no more bottles"
WHEN 1:
unit$ = "1 bottle"
OTHERWISE:
unit$ = STR$((N_Bottles + 100) MOD 100) + " bottles"
ENDCASE
PRINT unit$ beer$ wall$ "."
ENDWHILE
END

142
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-6.basic Normal file
View file

@ -0,0 +1,142 @@
DEF Win:WINDOW
DEF Close:CHAR
DEF ScreenSizeX,ScreenSizeY:INT
DECLARE VSpace(Number:UINT)
DECLARE CLR()
DEF TheLine$[4],Number$,Erase:STRING
DEF TheLine,TextHeight,TextWidth:INT
DEF TextX,TextY:UINT
TheLine$[0]="bottles"
TheLine$[1]="of beer on the wall."
TheLine$[2]="of beer."
TheLine$[3]="Take one down, pass it around."
BottlesOfBeer=99
TheLine=1
GETSCREENSIZE(ScreenSizeX,ScreenSizeY)
WINDOW Win,0,0,ScreenSizeX,ScreenSizeY,@MINBOX|@MAXBOX|@SIZE,0,"99 Bottles Of Beer",MainHandler
GETTEXTSIZE(Win,TheLine$[3],TextWidth,TextHeight)
Erase$=STRING$(TextWidth," ")
PRINT Win,"Let's sing a song."
VSpace(2)
'1.2 seconds.
STARTTIMER Win,1200
GOSUB Sing
WAITUNTIL Close=1
CLOSEWINDOW Win
END
SUB MainHandler
SELECT @CLASS
CASE @IDCLOSEWINDOW
Close=1
CASE @IDTIMER
GOSUB Sing
ENDSELECT
RETURN
SUB Sing
DEF Sing:INT
Sing=TheLine
MOVE Win,TextX,TextY
Number$=STR$(BottlesOfBeer)
IF BottlesOfBeer=0
Number$="No more"
TheLine$[0]="bottles"
TheLine$[3]="Go to the store and buy some more."
ENDIF
IF BottlesOfBeer=1
TheLine$[0]="bottle"
TheLine$[3]="Take it down, pass it around."
ENDIF
IF TheLine=4 THEN Sing=1
IF (TheLine=1)|(TheLine=2)|(TheLine=4)
IF BottlesOfBeer>-1 THEN PRINT Win,Number$+" "+TheLine$[0]+" "+TheLine$[Sing] ELSE GOSUB TheEnd
ELSE
PRINT Win,TheLine$[3]
BottlesOfBeer=BottlesOfBeer-1
ENDIF
TheLine=TheLine+1
VSpace(1)
IF TheLine>4
TheLine=1
VSpace(1)
ENDIF
RETURN
SUB TheEnd
PRINT Win,"What's the problem, offishur?"
STOPTIMER Win
VSpace(2)
MOVE Win,TextX,TextY:PRINT Win,"That's all."
RETURN
SUB VSpace(Number:UINT)
TextY=TextY+(TextHeight*Number)
IF TextY+(TextHeight*8)>ScreenSizeY THEN CLR()
RETURN
SUB CLR()
FOR X=0 TO ScreenSizeY
MOVE Win,0,X:PRINT Win,Erase$
TextY=8
NEXT X
RETURN

111
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-7.basic Normal file
View file

@ -0,0 +1,111 @@
REM Using the ESC key to exit will not work in console programs under Windows 95/98 or ME.
DECLARE SingWallLn()
DECLARE Delay1()
DECLARE Delay2()
'To use ESC Key to exit.
DECLARE Quit()
DECLARE TheEnd()
DEF Bottles:UINT
DEF Number$,Again$:STRING
OPENCONSOLE
PRINT"I'm going to sing a song.":PRINT
Delay1()
LABEL StartSong
Bottles=99
DO
Quit()
SingWallLn():Delay1()
PRINT LTRIM$(STR$(Bottles))+Number$+" of beer.":Delay1()
IF Bottles>0 THEN PRINT"Take one down, pass it around." ELSE PRINT"Take it down, pass it around.":Delay1()
Bottles=Bottles-1
SingWallLn()
Delay2()
PRINT:PRINT
UNTIL Bottles=0
Delay2()
ClS
LABEL Question
INPUT"Sing it again (y or n)?",Again$
SELECT Again$
CASE("y")
CASE("Y")
CLS
GOTO StartSong
CASE "n"
CASE "N"
CLS
PRINT"Fine, be that way.":Delay2()
TheEnd()
ENDSELECT
PRINT"Sorry, I didn't understand.":PRINT
GOTO Question
'Keep from running into subroutines.
END
SUB SingWallLn()
IF Bottles=1 THEN Number$=" bottle" ELSE Number$=" bottles"
PRINT LTRIM$(STR$(Bottles))+Number$+" of beer on the wall."
RETURN
SUB Delay1()
FOR X=1 TO 7000:NEXT X
RETURN
SUB Delay2()
FOR X=1 TO 1750000:NEXT X
RETURN
SUB Quit()
'Close program by pressing the ESC key.
'Will not work in console under Windows 95/98 or ME.
IF GETKEYSTATE(0x1B) THEN TheEnd()
RETURN
SUB TheEnd()
CLOSECONSOLE
END
RETURN

60
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-8.basic Normal file
View file

@ -0,0 +1,60 @@
#AppType Console
Class Wall
bottles
Sub Initialize(%n = 99)
bottles = n
End Sub
Method Denom()
if bottles+1 > 1 then
return "one"
elseif bottles+1 = 1 then
return "it"
end if
End Method
Method StockUp( %n = 99 )
bottles = n
End Method
Method TakeOneDown()
bottles = bottles - 1
end Method
Method Pluraliser()
if bottles > 1 then
return "s"
else
return ""
end if
end method
Method Sing()
print bottles, " bottle", Pluraliser(), " of beer on the wall"
print bottles, " bottle", Pluraliser(), " of beer"
TakeOneDown()
print "take ", Denom(), " down and pass it round"
if bottles > 0 then
print bottles, " bottle", Pluraliser(), " of beer on the wall"
print
else
print "no more bottles of beer on the wall"
print
print "no more bottles of beer on the wall"
print "no more bottles of beer on the wall"
print "go to the store and buy some more"
StockUp(99)
print bottles, " bottle", Pluraliser(), " of beer on the wall"
print
end if
return bottles
End Method
End Class
Dim BeerSong as new Wall(99)
while BeerSong.Sing() <> 99
end while

28
Task/99-Bottles-of-Beer/BASIC/99-bottles-of-beer-9.basic Normal file
View file

@ -0,0 +1,28 @@
E000G (APPLE II)
E000R (APPLE I)
10 REM -------------------------
11 REM BEERSONG IN APPLE INTEGER
12 REM BASIC BY BARRYM 2011-8-21
13 REM THANKS : APPLEWIN1.17.2.0
14 REM THANKS ALSO : POM1 0.7B
15 REM -------------------------
16 REM PRINTS THE COMPLETE UPPER
17 REM CASE LYRICS ON AN APPLE I
18 REM OR AN 'ORIGINAL' APPLE II
19 REM WITH WOZ'S INTEGER BASIC.
20 REM -------------------------
21 REM THIS BASIC HAS AN UNUSUAL
22 REM 'THEN', WHICH EXECUTES OR
23 REM SKIPS ONE (AND ONLY ONE!)
24 REM STATEMENT. THIS CONFUSED
25 REM US KIDS REGULARLY WHEN WE
26 REM TRIED TRANSLATING INTEGER
27 REM BASIC GAMES TO APPLE$OFT!
30 REM -------------------------
40 FOR B=99 TO 98 STEP 0: PRINT : FOR W=0 TO 2: IF W<2 THEN 70
50 IF B THEN PRINT "TAKE ONE DOWN AND PASS IT AROUND";:B=B-1
60 IF B+1 THEN 70:B=99: PRINT "GO TO THE STORE AND BUY SOME MORE";
70 IF W THEN PRINT ",": IF B THEN PRINT B;: IF B=0 THEN PRINT "NO MORE";
80 PRINT " BOTTLE";: IF B#1 THEN PRINT "S";: PRINT " OF BEER";
90 IF W#1 THEN PRINT " ON THE WALL";: IF W THEN PRINT ".": NEXT W,B: END
RUN

15
Task/99-Bottles-of-Beer/C++/99-bottles-of-beer-1.cpp
View file

@ -1,13 +1,12 @@
#include <iostream>
using namespace std;
using std::cout;
int main()
{
int bottles = 99;
do {
cout << bottles << " bottles of beer on the wall" << endl;
cout << bottles << " bottles of beer" << endl;
cout << "Take one down, pass it around" << endl;
cout << --bottles << " bottles of beer on the wall\n" << endl;
} while (bottles > 0);
for(int bottles(99); bottles > 0; bottles -= 1){
cout << bottles << " bottles of beer on the wall\n"
<< bottles << " bottles of beer\n"
<< "Take one down, pass it around\n"
<< bottles - 1 << " bottles of beer on the wall\n\n";
}
}

53
Task/99-Bottles-of-Beer/C-sharp/99-bottles-of-beer-3.cs
View file

@ -1,28 +1,39 @@
class songs
{
static void Main(string[] args)
class Program
{
beer(5);
}
const string Vessel = "bottle";
const string Beverage = "beer";
const string Location = "on the wall";
private static void beer(int bottles)
{
for (int i = bottles; i > 0; i--)
private static string DefaultAction(ref int bottles)
{
if (i > 1)
bottles--;
return "take one down, pass it around,";
}
private static string FallbackAction(ref int bottles)
{
bottles += 99;
return "go to the store, buy some more,";
}
private static string Act(ref int bottles)
{
return bottles > 0 ? DefaultAction(ref bottles) : FallbackAction(ref bottles);
}
static void Main()
{
Func<int, string> plural = b => b == 1 ? "" : "s";
Func<int, string> describeCount = b => b == 0 ? "no more" : b.ToString();
Func<int, string> describeBottles = b => string.Format("{0} {1}{2} of {3}", describeCount(b), Vessel, plural(b), Beverage);
Action<string> write = s => Console.WriteLine(CultureInfo.CurrentCulture.TextInfo.ToTitleCase(s));
int bottles = 99;
while (true)
{
Console.Write("{0}\n{1}\n{2}\n{3}\n\n",
i + " bottles of beer on the wall",
i + " bottles of beer",
"Take one down, pass it around",
(i - 1) + " bottles of beer on the wall");
write(string.Format("{0} {1}, {0},", describeBottles(bottles), Location));
write(Act(ref bottles));
write(string.Format("{0} {1}.", describeBottles(bottles), Location));
write(string.Empty);
}
else
Console.Write("{0}\n{1}\n{2}\n{3}\n\n",
i + " bottle of beer on the wall",
i + " bottle of beer",
"Take one down, pass it around",
(i - 1) + " bottles of beer on the wall....");
}
}
}

35
Task/99-Bottles-of-Beer/C-sharp/99-bottles-of-beer-4.cs
View file

@ -1,21 +1,28 @@
using System;
using System.Linq;
class Program
class songs
{
static void Main()
static void Main(string[] args)
{
BeerBottles().Take(99).ToList().ForEach(Console.WriteLine);
beer(5);
}
static IEnumerable<String> BeerBottles()
private static void beer(int bottles)
{
int i = 100;
String f = "{0}, {1}. Take one down, pass it around, {2}";
Func<int, bool, String> booze = (c , b) =>
String.Format("{0} bottle{1} of beer{2}", c > 0 ? c.ToString() : "no more", (c == 1 ? "" : "s"), b ? " on the wall" : "");
while (--i >= 1)
yield return String.Format(f, booze(i, true), booze(i, false), booze(i - 1, true));
for (int i = bottles; i > 0; i--)
{
if (i > 1)
{
Console.Write("{0}\n{1}\n{2}\n{3}\n\n",
i + " bottles of beer on the wall",
i + " bottles of beer",
"Take one down, pass it around",
(i - 1) + " bottles of beer on the wall");
}
else
Console.Write("{0}\n{1}\n{2}\n{3}\n\n",
i + " bottle of beer on the wall",
i + " bottle of beer",
"Take one down, pass it around",
(i - 1) + " bottles of beer on the wall....");
}
}
}

144
Task/99-Bottles-of-Beer/C-sharp/99-bottles-of-beer-5.cs
View file

@ -1,131 +1,21 @@
string[] bottles = { "80 Shilling",
"Abita Amber",
"Adams Broadside Ale",
"Altenmünster Premium",
"August Schell's SnowStorm",
"Bah Humbug! Christmas Ale",
"Beck's Oktoberfest",
"Belhaven Wee Heavy",
"Bison Chocolate Stout",
"Blue Star Wheat Beer",
"Bridgeport Black Strap Stout",
"Brother Thelonius Belgian-Style Abbey Ale",
"Capital Blonde Doppelbock",
"Carta Blanca",
"Celis Raspberry Wheat",
"Christian Moerlein Select Lager",
"Corona",
"Czechvar",
"Delirium Tremens",
"Diamond Bear Southern Blonde",
"Don De Dieu",
"Eastside Dark",
"Eliot Ness",
"Flying Dog K-9 Cruiser Altitude Ale",
"Fuller's London Porter",
"Gaffel Kölsch",
"Golden Horseshoe",
"Guinness Pub Draught",
"Hacker-Pschorr Weisse",
"Hereford & Hops Black Spring Double Stout",
"Highland Oatmeal Porter",
"Ipswich Ale",
"Iron City",
"Jack Daniel's Amber Lager",
"Jamaica Sunset India Pale Ale",
"Killian's Red",
"König Ludwig Weiss",
"Kronenbourg 1664",
"Lagunitas Hairy Eyball Ale",
"Left Hand Juju Ginger",
"Locktender Lager",
"Magic Hat Blind Faith",
"Missing Elf Double Bock",
"Muskoka Cream Ale ",
"New Glarus Cherry Stout",
"Nostradamus Bruin",
"Old Devil",
"Ommegang Three Philosophers",
"Paulaner Hefe-Weizen Dunkel",
"Perla Chmielowa Pils",
"Pete's Wicked Springfest",
"Point White Biere",
"Prostel Alkoholfrei",
"Quilmes",
"Rahr's Red",
"Rebel Garnet",
"Rickard's Red",
"Rio Grande Elfego Bock",
"Rogue Brutal Bitter",
"Roswell Alien Amber Ale",
"Russian River Pliny The Elder",
"Samuel Adams Blackberry Witbier",
"Samuel Smith's Taddy Porter",
"Schlafly Pilsner",
"Sea Dog Wild Blueberry Wheat Ale",
"Sharp's",
"Shiner 99",
"Sierra Dorada",
"Skullsplitter Orkney Ale",
"Snake Chaser Irish Style Stout",
"St. Arnold Bock",
"St. Peter's Cream Stout",
"Stag",
"Stella Artois",
"Stone Russian Imperial Stout",
"Sweetwater Happy Ending Imperial Stout",
"Taiwan Gold Medal",
"Terrapin Big Hoppy Monster",
"Thomas Hooker American Pale Ale",
"Tie Die Red Ale",
"Toohey's Premium",
"Tsingtao",
"Ugly Pug Black Lager",
"Unibroue Qatre-Centieme",
"Victoria Bitter",
"Voll-Damm Doble Malta",
"Wailing Wench Ale",
"Warsteiner Dunkel",
"Wellhead Crude Oil Stout",
"Weyerbacher Blithering Idiot Barley-Wine Style Ale",
"Wild Boar Amber",
"Würzburger Oktoberfest",
"Xingu Black Beer",
"Yanjing",
"Younger's Tartan Special",
"Yuengling Black & Tan",
"Zagorka Special",
"Zig Zag River Lager",
"Zywiec" };
using System;
using System.Linq;
int bottlesLeft = 99;
const int FIRST_LINE_SINGULAR = 98;
const int FINAL_LINE_SINGULAR = 97;
string firstLine = "";
string finalLine = "";
for (int i = 0; i < 99; i++)
class Program
{
firstLine = bottlesLeft.ToString() + " bottle";
if (i != FIRST_LINE_SINGULAR)
firstLine += "s";
firstLine += " of beer on the wall, " + bottlesLeft.ToString() + " bottle";
if (i != FIRST_LINE_SINGULAR)
firstLine += "s";
firstLine += " of beer";
static void Main()
{
BeerBottles().Take(99).ToList().ForEach(Console.WriteLine);
}
Console.WriteLine(firstLine);
Console.WriteLine("Take the " + bottles[i] + " down, pass it around,");
bottlesLeft--;
finalLine = bottlesLeft.ToString() + " bottle";
if (i != FINAL_LINE_SINGULAR)
finalLine += "s";
finalLine += " of beer on the wall!";
Console.WriteLine(finalLine);
Console.WriteLine();
Console.ReadLine();
static IEnumerable<String> BeerBottles()
{
int i = 100;
String f = "{0}, {1}. Take one down, pass it around, {2}";
Func<int, bool, String> booze = (c , b) =>
String.Format("{0} bottle{1} of beer{2}", c > 0 ? c.ToString() : "no more", (c == 1 ? "" : "s"), b ? " on the wall" : "");
while (--i >= 1)
yield return String.Format(f, booze(i, true), booze(i, false), booze(i - 1, true));
}
}

131
Task/99-Bottles-of-Beer/C-sharp/99-bottles-of-beer-6.cs Normal file
View file

@ -0,0 +1,131 @@
string[] bottles = { "80 Shilling",
"Abita Amber",
"Adams Broadside Ale",
"Altenmünster Premium",
"August Schell's SnowStorm",
"Bah Humbug! Christmas Ale",
"Beck's Oktoberfest",
"Belhaven Wee Heavy",
"Bison Chocolate Stout",
"Blue Star Wheat Beer",
"Bridgeport Black Strap Stout",
"Brother Thelonius Belgian-Style Abbey Ale",
"Capital Blonde Doppelbock",
"Carta Blanca",
"Celis Raspberry Wheat",
"Christian Moerlein Select Lager",
"Corona",
"Czechvar",
"Delirium Tremens",
"Diamond Bear Southern Blonde",
"Don De Dieu",
"Eastside Dark",
"Eliot Ness",
"Flying Dog K-9 Cruiser Altitude Ale",
"Fuller's London Porter",
"Gaffel Kölsch",
"Golden Horseshoe",
"Guinness Pub Draught",
"Hacker-Pschorr Weisse",
"Hereford & Hops Black Spring Double Stout",
"Highland Oatmeal Porter",
"Ipswich Ale",
"Iron City",
"Jack Daniel's Amber Lager",
"Jamaica Sunset India Pale Ale",
"Killian's Red",
"König Ludwig Weiss",
"Kronenbourg 1664",
"Lagunitas Hairy Eyball Ale",
"Left Hand Juju Ginger",
"Locktender Lager",
"Magic Hat Blind Faith",
"Missing Elf Double Bock",
"Muskoka Cream Ale ",
"New Glarus Cherry Stout",
"Nostradamus Bruin",
"Old Devil",
"Ommegang Three Philosophers",
"Paulaner Hefe-Weizen Dunkel",
"Perla Chmielowa Pils",
"Pete's Wicked Springfest",
"Point White Biere",
"Prostel Alkoholfrei",
"Quilmes",
"Rahr's Red",
"Rebel Garnet",
"Rickard's Red",
"Rio Grande Elfego Bock",
"Rogue Brutal Bitter",
"Roswell Alien Amber Ale",
"Russian River Pliny The Elder",
"Samuel Adams Blackberry Witbier",
"Samuel Smith's Taddy Porter",
"Schlafly Pilsner",
"Sea Dog Wild Blueberry Wheat Ale",
"Sharp's",
"Shiner 99",
"Sierra Dorada",
"Skullsplitter Orkney Ale",
"Snake Chaser Irish Style Stout",
"St. Arnold Bock",
"St. Peter's Cream Stout",
"Stag",
"Stella Artois",
"Stone Russian Imperial Stout",
"Sweetwater Happy Ending Imperial Stout",
"Taiwan Gold Medal",
"Terrapin Big Hoppy Monster",
"Thomas Hooker American Pale Ale",
"Tie Die Red Ale",
"Toohey's Premium",
"Tsingtao",
"Ugly Pug Black Lager",
"Unibroue Qatre-Centieme",
"Victoria Bitter",
"Voll-Damm Doble Malta",
"Wailing Wench Ale",
"Warsteiner Dunkel",
"Wellhead Crude Oil Stout",
"Weyerbacher Blithering Idiot Barley-Wine Style Ale",
"Wild Boar Amber",
"Würzburger Oktoberfest",
"Xingu Black Beer",
"Yanjing",
"Younger's Tartan Special",
"Yuengling Black & Tan",
"Zagorka Special",
"Zig Zag River Lager",
"Zywiec" };
int bottlesLeft = 99;
const int FIRST_LINE_SINGULAR = 98;
const int FINAL_LINE_SINGULAR = 97;
string firstLine = "";
string finalLine = "";
for (int i = 0; i < 99; i++)
{
firstLine = bottlesLeft.ToString() + " bottle";
if (i != FIRST_LINE_SINGULAR)
firstLine += "s";
firstLine += " of beer on the wall, " + bottlesLeft.ToString() + " bottle";
if (i != FIRST_LINE_SINGULAR)
firstLine += "s";
firstLine += " of beer";
Console.WriteLine(firstLine);
Console.WriteLine("Take the " + bottles[i] + " down, pass it around,");
bottlesLeft--;
finalLine = bottlesLeft.ToString() + " bottle";
if (i != FINAL_LINE_SINGULAR)
finalLine += "s";
finalLine += " of beer on the wall!";
Console.WriteLine(finalLine);
Console.WriteLine();
Console.ReadLine();
}

16
Task/99-Bottles-of-Beer/COBOL/99-bottles-of-beer-3.cobol Normal file
View file

@ -0,0 +1,16 @@
program-id. ninety-nine.
data division.
working-storage section.
01 cnt pic 99.
procedure division.
perform varying cnt from 99 by -1 until cnt < 1
display cnt " bottles of beer on the wall"
display cnt " bottles of beer"
display "Take one down, pass it around"
subtract 1 from cnt
display cnt " bottles of beer on the wall"
add 1 to cnt
display space
end-perform.

2
Task/99-Bottles-of-Beer/Common-Lisp/99-bottles-of-beer-3.lisp Normal file
View file

@ -0,0 +1,2 @@
(format t "~{~[~^~]~:*~D bottle~:P of beer on the wall~%~:*~D bottle~:P of beer~%Take one down, pass it around~%~D bottle~:P~:* of beer on the wall~2%~}"
(loop :for n :from 99 :downto 0 :collect n))

0
Task/99-Bottles-of-Beer/D/99-bottles-of-beer.d → Task/99-Bottles-of-Beer/D/99-bottles-of-beer-1.d
View file

24
Task/99-Bottles-of-Beer/D/99-bottles-of-beer-2.d Normal file
View file

@ -0,0 +1,24 @@
import std.stdio, std.conv;
string bottles(in size_t num) pure {
static string bottlesRecurse(in size_t num) pure {
return num.text ~ " bottles of beer on the wall,\n"
~ num.text ~ " bottles of beer!\n"
~ "Take one down, pass it around,\n"
~ (num - 1).text ~ " bottle" ~ ((num - 1 == 1) ? "" : "s")
~ " of beer on the wall.\n\n"
~ ((num > 2)
? bottlesRecurse(num - 1)
: "1 bottle of beer on the wall,\n"
~ "1 bottle of beer!\n"
~ "Take one down, pass it around,\n"
~ "No bottles of beer on the wall!\n\n");
}
return bottlesRecurse(num)
~ "Go to the store and buy some more...\n"
~ num.text ~ " bottles of beer on the wall!";
}
pragma(msg, 99.bottles);
void main() {}

17
Task/99-Bottles-of-Beer/Deja-Vu/99-bottles-of-beer.djv Normal file
View file

@ -0,0 +1,17 @@
plural i:
if = 1 i "" "s"
bottles i:
local :s plural i
!print( to-str i " bottle"s" of beer on the wall, " to-str i " bottle"s" of beer," )
!print\ "You take one down, pass it around, "
set :i -- i
if i:
set :s plural i
!print( to-str i " bottle"s" of beer on the wall." )
bottles i
else:
!print "no more bottles of beer on the wall, no more bottles of beer."
!print "Go to the store and buy some more, 99 bottles of beer on the wall."
bottles 99

0
Task/99-Bottles-of-Beer/Haxe/99-bottles-of-beer.haxe → Task/99-Bottles-of-Beer/Haxe/99-bottles-of-beer-1.haxe
View file

33
Task/99-Bottles-of-Beer/Haxe/99-bottles-of-beer-2.haxe Normal file
View file

@ -0,0 +1,33 @@
class Bottles {
static public function main () : Void {
singBottlesOfBeer(100);
}
macro static public function singBottlesOfBeer (bottles:Int) {
var lines = [];
var s : String = 's';
var song : String = '';
while( bottles >= 1 ){
song += '$bottles bottle$s of beer on the wall,\n';
song += '$bottles bottle$s of beer!\n';
song += 'Take one down, pass it around,\n';
bottles --;
if( bottles > 1 ){
song += '$bottles bottles of beer on the wall!\n\n';
}else if( bottles == 1 ){
s = '';
song += '$bottles bottle of beer on the wall!\n\n';
}else{
song += 'No more bottles of beer on the wall!\n';
}
}
return macro Sys.print($v{song});
}
}

59
Task/99-Bottles-of-Beer/Java/99-bottles-of-beer-3.java
View file

@ -1,40 +1,21 @@
import java.awt.BorderLayout;
import java.awt.event.ActionEvent;
import java.awt.event.ActionListener;
import javax.swing.JButton;
import javax.swing.JFrame;
import javax.swing.JOptionPane;
import javax.swing.JTextArea;
public class Beer extends JFrame implements ActionListener{
private int x;
private JButton take;
private JTextArea text;
public static void main(String[] args){
new Beer();//build and show the GUI
}
public Beer(){
x= 99;
take= new JButton("Take one down, pass it around");
text= new JTextArea(4,30);//size the area to 4 lines, 30 chars each
text.setText(x + " bottles of beer on the wall\n" + x + " bottles of beer");
text.setEditable(false);//so they can't change the text after it's displayed
take.addActionListener(this);//listen to the button
setLayout(new BorderLayout());//handle placement of components
add(text, BorderLayout.CENTER);//put the text area in the largest section
add(take, BorderLayout.SOUTH);//put the button underneath it
pack();//auto-size the window
setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);//exit on "X" (I hate System.exit...)
setVisible(true);//show it
}
public void actionPerformed(ActionEvent arg0){
if(arg0.getSource() == take){//if they clicked the button
JOptionPane.showMessageDialog(null, --x + " bottles of beer on the wall");//show a popup message
text.setText(x + " bottles of beer on the wall\n" + x + " bottles of beer");//change the text
}
if(x == 0){//if it's the end
dispose();//end
}
}
public class Beer
{
public static void main(String args[])
{
song(99);
}
public static void song(int b)
{
if(b>=0)
{
if(b>1)
System.out.println(b+" bottles of beer on the wall\n"+b+" bottles of beer\nTake one down, pass it around\n"+(b-1)+" bottles of beer on the wall.\n");
else if(b==1)
System.out.println(b+" bottle of beer on the wall\n"+b+" bottle of beer\nTake one down, pass it around\n"+(b-1)+" bottles of beer on the wall.\n");
else
System.out.println(b+" bottles of beer on the wall\n"+b+" bottles of beer\nBetter go to the store and buy some more!");
song(b-1);
}
}
}

40
Task/99-Bottles-of-Beer/Java/99-bottles-of-beer-4.java Normal file
View file

@ -0,0 +1,40 @@
import java.awt.BorderLayout;
import java.awt.event.ActionEvent;
import java.awt.event.ActionListener;
import javax.swing.JButton;
import javax.swing.JFrame;
import javax.swing.JOptionPane;
import javax.swing.JTextArea;
public class Beer extends JFrame implements ActionListener{
private int x;
private JButton take;
private JTextArea text;
public static void main(String[] args){
new Beer();//build and show the GUI
}
public Beer(){
x= 99;
take= new JButton("Take one down, pass it around");
text= new JTextArea(4,30);//size the area to 4 lines, 30 chars each
text.setText(x + " bottles of beer on the wall\n" + x + " bottles of beer");
text.setEditable(false);//so they can't change the text after it's displayed
take.addActionListener(this);//listen to the button
setLayout(new BorderLayout());//handle placement of components
add(text, BorderLayout.CENTER);//put the text area in the largest section
add(take, BorderLayout.SOUTH);//put the button underneath it
pack();//auto-size the window
setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);//exit on "X" (I hate System.exit...)
setVisible(true);//show it
}
public void actionPerformed(ActionEvent arg0){
if(arg0.getSource() == take){//if they clicked the button
JOptionPane.showMessageDialog(null, --x + " bottles of beer on the wall");//show a popup message
text.setText(x + " bottles of beer on the wall\n" + x + " bottles of beer");//change the text
}
if(x == 0){//if it's the end
dispose();//end
}
}
}

34
Task/99-Bottles-of-Beer/Oxygene/99-bottles-of-beer.oxy Normal file
View file

@ -0,0 +1,34 @@
namespace ConsoleApplication2;
interface
type
ConsoleApp = class
public
class method Main(args: array of String);
end;
implementation
method bottles(number: Integer): String;
begin
if (number = 1) then
Result := "bottle"
else
Result := "bottles";
end;
class method ConsoleApp.Main(args: array of String);
begin
for n: Integer := 99 downto 1 do
begin
Console.WriteLine("{0} {1} of beer on the wall,",n,bottles(n));
Console.WriteLine("{0} {1} of beer,",n,bottles(n));
Console.WriteLine("Take one down, and pass it around,");
Console.WriteLine("{0} {1} of beer on the wall.",n-1,bottles(n-1));
Console.WriteLine();
end;
Console.ReadKey();
end;
end.

16
Task/99-Bottles-of-Beer/PHP/99-bottles-of-beer-5.php Normal file
View file

@ -0,0 +1,16 @@
<?php
$bottles = 99;
while ($bottles > 0) {
printf(ngettext('%d bottle', '%d bottles', $bottles) . " of beer on the wall\n", $bottles); //X bottles of beer on the wall
printf(ngettext('%d bottle', '%d bottles', $bottles) . " of beer\n", $bottles); //X bottles of beer
printf("Take one down, pass it around\n"); //Take one down, pass it around
$bottles--;
if ($bottles > 0) {
printf(ngettext('%d bottle', '%d bottles', $bottles) . " of beer on the wall\n\n", $bottles); //X bottles of beer on the wall
}
}
printf('No more bottles of beer on the wall'); //No more bottles of beer on the wall

6
Task/99-Bottles-of-Beer/Ruby/99-bottles-of-beer-5.rb Normal file
View file

@ -0,0 +1,6 @@
99.downto(1) do |bottles|
puts "#{bottles} bottle#{"s" if bottles != 1} of beer on the wall.",
"#{bottles} bottle#{"s" if bottles != 1} of beer.",
"Take one down, pass it around.",
"#{bottles - 1} bottle#{"s" if bottles - 1 != 1} of beer on the wall.\n\n"
end

27
Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer.rust Normal file
View file

@ -0,0 +1,27 @@
// rust is changing fast, so this will probably not work in later versions
use std::iter::range_step_inclusive;
fn main() {
for num_bottles in range_step_inclusive(99, 1, -1) {
sing_bottles_line(num_bottles, true);
sing_bottles_line(num_bottles, false);
println("Take one down, pass it around...");
sing_bottles_line(num_bottles - 1, true);
println("-----------------------------------");
}
}
fn sing_bottles_line(num_bottles: int, on_the_wall: bool) {
// the print! macro uses a built in internationalization formatting language
// check out the docs for std::fmt
print!("{0, plural, =0{No bottles} =1{One bottle} other{# bottles}} of beer", num_bottles as uint);
// this is to demonstrate the select "method"
// it's probably not the best way to do it
// it needs a &str so I had to use that tmp variable to trick it
// hopefully someone else can fix it for me
let tmp: &str = on_the_wall.to_str();
println!("{0, select, true{ on the wall} other{}}!", tmp);
}

24
Task/99-Bottles-of-Beer/Visual-Prolog/99-bottles-of-beer.pro Normal file
View file

@ -0,0 +1,24 @@
implement main
open core, std, console
class predicates
bottles : (integer) -> string procedure (i).
clauses
bottles(1) = "bottle" :- !.
bottles(_) = "bottles".
run():-
init(),
foreach B = downTo(99,1) do
write(B," ",bottles(B), " of beer on the wall,\n"),
write(B," ",bottles(B), " of beer,\n"),
write("Take one down, pass it around,\n"),
write(B-1," ",bottles(B-1)," of beer on the wall.\n\n")
end foreach,
succeed().
end implement main
goal
mainExe::run(main::run).

71
Task/99-Bottles-of-Beer/Z80-Assembly/99-bottles-of-beer.z80 Normal file
View file

@ -0,0 +1,71 @@
org 32768
start:
ld a, 2 ; Spectrum: channel 2 = "S" for screen
call $1601 ; Spectrum: Select print channel using ROM
ld c,99 ; Number of bottles to start with
loopstart:
call printc ; Print the number of bottles
ld hl,line1 ; Print the rest of the first line
call printline
call printc ; Print the number of bottles
ld hl,line2_3 ; Print rest of the 2nd and 3rd lines
call printline
dec c ; Take one bottle away
call printc ; Print the number of bottles
ld hl,line4 ; Print the rest of the fourth line
call printline
ld a,c
cp 0 ; Out of beer bottles?
jp nz,loopstart ; If not, loop round again
ret ; Return to BASIC
printc: ; Routine to print C register as ASCII decimal
ld a,c
call dtoa2d ; Split A register into D and E
ld a,d ; Print first digit in D
cp '0' ; Don't bother printing leading 0
jr z,printc2
rst 16 ; Spectrum: Print the character in 'A'
printc2:
ld a,e ; Print second digit in E
rst 16 ; Spectrum: Print the character in 'A'
ret
printline: ; Routine to print out a line
ld a,(hl) ; Get character to print
cp '$' ; See if it '$' terminator
jp z,printend ; We're done if it is
rst 16 ; Spectrum: Print the character in 'A'
inc hl ; Move onto the next character
jp printline ; Loop round
printend:
ret
dtoa2d: ; Decimal to ASCII (2 digits only), in: A, out: DE
ld d,'0' ; Starting from ASCII '0'
dec d ; Because we are inc'ing in the loop
ld e,10 ; Want base 10 please
and a ; Clear carry flag
dtoa2dloop:
inc d ; Increase the number of tens
sub e ; Take away one unit of ten from A
jr nc,dtoa2dloop ; If A still hasn't gone negative, do another
add a,e ; Decreased it too much, put it back
add a,'0' ; Convert to ASCII
ld e,a ; Stick remainder in E
ret
; Data
line1: defb ' bottles of beer on the wall,',13,'$'
line2_3: defb ' bottles of beer,',13,'Take one down, pass it around,',13,'$'
line4: defb ' bottles of beer on the wall.',13,13,'$'

10
Task/A+B/D/a+b-2.d
View file

@ -1,8 +1,6 @@
import std.stdio, std.conv, std.string;
void main() {
auto fin = File("sum_input.txt", "r");
auto r = fin.readln().split();
auto fout = File("sum_output.txt", "w");
fout.writeln(to!int(r[0]) + to!int(r[1]));
import std.stdio, std.file;
immutable ab = "sum_input.txt".slurp!(int, int)("%d %d")[0];
"sum_output.txt".File("w").writeln(ab[0] + ab[1]);
}

27
Task/A+B/Dart/a+b.dart Normal file
View file

@ -0,0 +1,27 @@
import 'dart:io';
import 'dart:convert';
bool isAnInteger(String str) => str.contains(new RegExp(r'^-?\d+$'));
void main() {
stdin.transform(new AsciiDecoder())
.transform(new LineSplitter())
.listen((String str) {
var strings = str.split(new RegExp(r'[ ]+')); // split on 1 or more spaces
if(!strings.every(isAnInteger)) {
print("not an integer!");
} else if(strings.length > 2) {
print("too many numbers!");
} else if(strings.length < 2) {
print('not enough numbers!');
} else {
// parse the strings into integers
var nums = strings.map((String s) => int.parse(s));
if(nums.any((num) => num < -1000 || num > 1000)) {
print("between -1000 and 1000 please!");
} else {
print(nums[0]+ nums[1]);
}
}
});
}

4
Task/A+B/Deja-Vu/a+b.djv
View file

@ -1,4 +1,4 @@
0
for k in split " " input:
for k in split !prompt "" " ":
+ to-num k
print
!print

9
Task/A+B/Elena/a+b.elena
View file

@ -1,10 +1,11 @@
#define system.
#define extensions'io.
#define extensions.
#symbol program =
[
#var A := consoleEx >> Integer new.
#var B := consoleEx >> Integer new.
#var A := Integer new.
#var B := Integer new.
consoleEx << A + B.
consoleEx readLine:A:B.
consoleEx writeLine:(A + B).
].

9
Task/A+B/GML/a+b.gml
View file

@ -1,4 +1,5 @@
add = argument0 // get the string with the numbers to add
a = real(string_copy(add, 1, string_pos(" ", add)))
b = real(string_copy(add, string_pos(" ", add) + 1, string_length(add) - string_pos(" ", add)))
return(a + b)
var add, a, b;
add = argument0; // get the string with the numbers to add
a = real(string_copy(add, 1, string_pos(" ", add)));
b = real(string_copy(add, string_pos(" ", add) + 1, string_length(add) - string_pos(" ", add)));
return(a + b);

1
Task/A+B/Scala/a+b-1.scala Normal file
View file

@ -0,0 +1 @@
println(readLine().split(" ").map(_.toInt).sum)

3
Task/A+B/Scala/a+b-2.scala Normal file
View file

@ -0,0 +1,3 @@
val s = new java.util.Scanner(System.in)
val sum = s.nextInt() + s.nextInt()
println(sum)

1
Task/A+B/Scala/a+b.scala
View file

@ -1 +0,0 @@
println(readLine() split " " take 2 map (_.toInt) sum)

2
Task/A+B/TXR/a+b.txr Normal file
View file

@ -0,0 +1,2 @@
@(do (let ((sum (+ (read) (read))))
(format t "~s\n" sum)))

7
Task/A+B/VBA/a+b.vba Normal file
View file

@ -0,0 +1,7 @@
Sub Rosetta_AB()
Dim stEval As String
stEval = InputBox("Enter two numbers, separated only by a space", "Rosetta Code", "2 2")
MsgBox "You entered " & stEval & vbCr & vbCr & _
"VBA converted this input to " & Replace(stEval, " ", "+") & vbCr & vbCr & _
"And evaluated the result as " & Evaluate(Replace(stEval, " ", "+")), vbInformation + vbOKOnly, "XLSM"
End Sub

0
Task/Abstract-type/ActionScript/abstract-type.as → Task/Abstract-type/ActionScript/abstract-type-1.as
View file

22
Task/Abstract-type/ActionScript/abstract-type-2.as Normal file
View file

@ -0,0 +1,22 @@
package {
import flash.utils.getQualifiedClassName;
public class AbstractClass {
private static const FULLY_QUALIFIED_NAME:String = "AbstractClass";
// For classes in a package, the fully qualified name should be in the form "package.name::class_name"
// Note that a double colon and not a dot is used before the class name. This is the format returned
// by the getQualifiedClassName() function.
public function AbstractClass() {
if ( getQualifiedClassName(this) == FULLY_QUALIFIED_NAME )
throw new Error("Class " + FULLY_QUALIFIED_NAME + " is abstract.");
}
public function abstractMethod(a:int, b:int):void {
throw new Error("abstractMethod is not implemented.");
}
}
}

10
Task/Abstract-type/ActionScript/abstract-type-3.as Normal file
View file

@ -0,0 +1,10 @@
package {
public class Example extends AbstractClass {
override public function abstractMethod(a:int, b:int):void {
trace(a + b);
}
}
}

2
Task/Abstract-type/C/abstract-type-2.c
View file

@ -1,6 +1,6 @@
#ifndef SILLY_H
#define SILLY_H
#include intefaceAbs.h
#include "intefaceAbs.h"
typedef struct sillyStruct *Silly;
extern Silly NewSilly( double, const char *);

2
Task/Accumulator-factory/Common-Lisp/accumulator-factory-1.lisp
View file

@ -1,3 +1,3 @@
(defun accumulator (sum)
(lambda (n)
(setf sum (+ sum n))))
(incf sum n)))

2
Task/Accumulator-factory/D/accumulator-factory.d
View file

@ -1,3 +1,5 @@
import std.stdio;
void main() {
auto x = acc(1);
x(5);

9
Task/Accumulator-factory/Dart/accumulator-factory.dart Normal file
View file

@ -0,0 +1,9 @@
Function accumulator(var n) => (var i) => n += i;
void main() {
var a = accumulator(42);
print("${a(0)}, ${a(1)}, ${a(10)}, ${a(100)}");
var b = accumulator(4.2);
print("${b(0)}, ${b(1)}, ${b(10.0)}, ${b(100.4)}");
}

2
Task/Accumulator-factory/Deja-Vu/accumulator-factory.djv
View file

@ -6,4 +6,4 @@ accum n:
local :x accum 1
drop x 5
drop accum 3
print x 2.3
!print x 2.3

4
Task/Accumulator-factory/Elena/accumulator-factory.elena
View file

@ -2,9 +2,9 @@
#define system'dynamic.
#symbol Function =
&&:x [ self append:x ].
(:x) [ self append:x ].
#symbol Accumulator = &&:anInitialValue
#symbol Accumulator = (:anInitialValue)
[ Wrap(Function, Variable new:anInitialValue) ].
#symbol Program =

12
Task/Accumulator-factory/TXR/accumulator-factory.txr Normal file
View file

@ -0,0 +1,12 @@
@(do
(defun accumulate (sum)
(lambda (n)
(inc sum n)))
;; test
(for ((f (accumulate 0))
num)
((set num (read)))
((format t "~s -> ~s\n" num [f num])))
(exit 0))

2
Task/Ackermann-function/C/ackermann-function-2.c
View file

@ -34,7 +34,7 @@ int main()
memset(cache, 0, sizeof(int) * (1 << (m_bits + n_bits)));
for (m = 0; m <= 4; m++)
for (n = 0; n < 6 - m; n++) {
for (n = 0; n < 6 - m; n++)
printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));
return 0;

28
Task/Ackermann-function/D/ackermann-function-2.d
View file

@ -1,9 +1,8 @@
import std.stdio, std.bigint, std.conv;
/*pure nothrow*/ BigInt ipow(/*in*/ BigInt base, /*in*/ BigInt exp){
auto result = BigInt(1);
//while (exp) {
while (exp != 0) {
BigInt ipow(BigInt base, BigInt exp) pure /*nothrow*/ {
auto result = 1.BigInt;
while (exp) {
//if (exp & 1)
if (exp % 2)
result *= base;
@ -14,37 +13,36 @@ import std.stdio, std.bigint, std.conv;
return result;
}
/*pure nothrow*/ BigInt ackermann(in int m, in int n)
BigInt ackermann(in int m, in int n) pure /*nothrow*/
in {
assert(m >= 0 && n >= 0);
} out(result) {
//assert(result >= 0);
//assert(cast()result >= 0);
assert(result >= 0);
} body {
/*pure nothrow*/ static BigInt ack(in int m, /*in*/ BigInt n) {
static BigInt ack(in int m, in BigInt n) pure /*nothrow*/ {
switch (m) {
case 0: return n + 1;
case 1: return n + 2;
case 2: return 3 + 2 * n;
//case 3: return 5 + 8 * (2 ^^ n - 1);
case 3: return 5 + 8 * (ipow(BigInt(2), n) - 1);
case 3: return 5 + 8 * (ipow(2.BigInt, n) - 1);
default: if (n == 0)
return ack(m - 1, BigInt(1));
return ack(m - 1, 1.BigInt);
else
return ack(m - 1, ack(m, n - 1));
}
}
return ack(m, BigInt(n));
return ack(m, n.BigInt);
}
void main() {
foreach (m; 1 .. 4)
foreach (n; 1 .. 9)
foreach (immutable m; 1 .. 4)
foreach (immutable n; 1 .. 9)
writefln("ackermann(%d, %d): %s", m, n, ackermann(m, n));
writefln("ackermann(4, 1): %s", ackermann(4, 1));
auto a = text(ackermann(4, 2));
immutable a = ackermann(4, 2).text;
writefln("ackermann(4, 2)) (%d digits):\n%s...\n%s",
a.length, a[0 .. 94], a[$-96 .. $]);
a.length, a[0 .. 94], a[$ - 96 .. $]);
}

12
Task/Ackermann-function/Elena/ackermann-function.elena
View file

@ -2,23 +2,21 @@
// --- Ackermann function ---
#symbol ackermann = &&:m:n
#symbol ackermann = (:m:n)
[
m =>
0 ? [ n + 1 ]
> 0 ? [
n => 0 ? [ $self:(m - 1):1 ]
> 0 ? [ $self:(m - 1):($self:m:(n-1)) ]
n => 0 ? [ ackermann:(m - 1):1 ]
> 0 ? [ ackermann:(m - 1):(ackermann:m:(n-1)) ]
]
].
#symbol program =
[
#var n := ackermann:3:5.
control from:0 &to:3 &do: &&:i
control from:0 &to:3 &do: i
[
control from:0 &to:5 &do: &&:j
control from:0 &to:5 &do: j
[
console << "A(" << i << "," << j << ")=" << (ackermann:i:j).

9
Task/Ackermann-function/TorqueScript/ackermann-function.torque Normal file
View file

@ -0,0 +1,9 @@
function ackermann(%m,%n)
{
if(%m==0)
return %n+1;
if(%m>0&&%n==0)
return ackermann(%m-1,1);
if(%m>0&&%n>0)
return ackermann(%m-1,ackermann(%m,%n-1));
}

2
Task/Add-a-variable-to-a-class-instance-at-runtime/D/add-a-variable-to-a-class-instance-at-runtime-1.d
View file

@ -5,7 +5,7 @@ struct Dynamic(T) {
return vars[key];
}
@property void opDispatch(string key, U)(U value)/*pure*/ nothrow {
@property void opDispatch(string key, U)(U value) pure nothrow {
vars[key] = value;
}
}

5
Task/Address-of-a-variable/Julia/address-of-a-variable-1.julia Normal file
View file

@ -0,0 +1,5 @@
julia> x = 3
julia> ptr = pointer_from_objref(x)
Ptr{Void} @0x000000010282e4a0
julia> unsafe_pointer_to_objref(ptr)
3

24
Task/Address-of-a-variable/Julia/address-of-a-variable-2.julia Normal file
View file

@ -0,0 +1,24 @@
julia> A = [1, 2.3, 4]
3-element Array{Float64,1}:
1.0
2.3
4.0
julia> p = pointer(A)
Ptr{Float64} @0x0000000113f70d60
julia> unsafe_load(p, 3)
4.0
julia> unsafe_store!(p, 3.14159, 3)
julia> A
3-element Array{Float64,1}:
1.0
2.3
3.14149
julia> pointer_to_array(p, (3,))
3-element Array{Float64,1}:
1.0
2.3
3.14149

8
Task/Address-of-a-variable/Julia/address-of-a-variable-3.julia Normal file
View file

@ -0,0 +1,8 @@
julia>
julia> q = convert(Ptr{Float64}, 0x0000000113f70d68)
Ptr{Float64} @0x0000000113f70d68
julia> B = pointer_to_array(q, (2,))
2-element Array{Float64,1}:
2.3
3.14149

83
Task/Align-columns/AutoIt/align-columns.autoit Normal file
View file

@ -0,0 +1,83 @@
; == If the given text is in an file, it will read with:
#include <File.au3>
Global $aRead
_FileReadToArray($sPath, $aRead) ; == $aRead[0] includes count of lines, every line stored in one item (without linebreak)
; == For example we get the same result with StringSplit()
Global $sText = _
"Given$a$text$file$of$many$lines,$where$fields$within$a$line$" & @CRLF & _
"are$delineated$by$a$single$'dollar'$character,$write$a$program" & @CRLF & _
"that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$" & @CRLF & _
"column$are$separated$by$at$least$one$space." & @CRLF & _
"Further,$allow$for$each$word$in$a$column$to$be$either$left$" & @CRLF & _
"justified,$right$justified,$or$center$justified$within$its$column." & @CRLF
$aRead = StringSplit($sText, @CRLF, 1)
; == strip leading and trailing "$" and trailing spaces, count remaining "$" to get max column number
Global $iMaxColumn = 0, $iLines = 0
For $i = 1 To $aRead[0]
If $aRead[$i] = '' Then ContinueLoop ; skip empty lines
$iLines += 1
$aRead[$i] = StringRegExpReplace(StringRegExpReplace(StringRegExpReplace($aRead[$i], '^\$', ''), '\$$', ''), '\s*$', '')
StringReplace($aRead[$i], '$', '$')
If @extended +1 > $iMaxColumn Then $iMaxColumn = @extended +1
Next
; == build array to store all fields and length of every item
Global $aFields[$iLines][$iMaxColumn +1][2]
; == and store the max. length of item in columns
Global $aColLen[$iMaxColumn]
; == fill the array
Global $aSplitLine
$iLines = 0
For $i = 1 To $aRead[0]
If $aRead[$i] = '' Then ContinueLoop ; skip empty lines
$iMaxColLen = 0
$aSplitLine = StringSplit($aRead[$i], '$')
For $j = 1 To $aSplitLine[0]
$aFields[$iLines][$j-1][0] = $aSplitLine[$j]
$aFields[$iLines][$j-1][1] = StringLen($aSplitLine[$j])
If $aFields[$iLines][$j-1][1] > $aColLen[$j-1] Then $aColLen[$j-1] = $aFields[$iLines][$j-1][1]
Next
$iLines += 1
Next
; == let the user select the alignment for every column
$sAlign = InputBox('Column alignment', 'There are ' & $iMaxColumn & ' columns.' & @LF & '0 = left 1 = center 2 = right' & @LF & _
'Input alignment for all columns without delimiters.' & @LF & 'Let it empty, to align all left.')
If $sAlign = '' Then
For $i = 1 To $iMaxColumn
$sAlign &= '0'
Next
EndIf
Global $aAlignment = StringSplit($sAlign, '', 2)
; == output all to console
Global $sLineOut
For $i = 0 To UBound($aFields) -1
$sLineOut = ''
For $j = 0 To $iMaxColumn -1
If $aFields[$i][$j][0] = '' Then ContinueLoop
$sLineOut &= _GetAligned($aFields[$i][$j][0], $aFields[$i][$j][1], $aAlignment[$j], $aColLen[$j])
Next
ConsoleWrite(StringTrimRight($sLineOut, 1) & @LF)
Next
Func _GetAligned($_sString, $_iLen, $_iAlign, $_iMaxLen)
Local $sSpace = ''
For $i = 1 To $_iMaxLen
$sSpace &= ' '
Next
Switch $_iAlign
Case 0
Return $_sString & StringLeft($sSpace, $_iMaxLen - $_iLen +1)
Case 1
Local $iLenLeft = Int(($_iMaxLen - $_iLen)/2)
Local $iLenRight = $_iMaxLen - $iLenLeft - $_iLen
Return StringLeft($sSpace, $iLenLeft) & $_sString & StringLeft($sSpace, $iLenRight) & ' '
Case 2
Return StringLeft($sSpace, $_iMaxLen - $_iLen) & $_sString & ' '
EndSwitch
EndFunc ;==>_GetAligned

40
Task/Align-columns/Julia/align-columns.julia Normal file
View file

@ -0,0 +1,40 @@
txt = """Given\$a\$txt\$file\$of\$many\$lines,\$where\$fields\$within\$a\$line\$
are\$delineated\$by\$a\$single\$'dollar'\$character,\$write\$a\$program
that\$aligns\$each\$column\$of\$fields\$by\$ensuring\$that\$words\$in\$each\$
column\$are\$separated\$by\$at\$least\$one\$space.
Further,\$allow\$for\$each\$word\$in\$a\$column\$to\$be\$either\$left\$
justified,\$right\$justified,\$or\$center\$justified\$within\$its\$column."""
# left/right/center justification of strings:
ljust(s, width) = s * " "^max(0, width - length(s))
rjust(s, width) = " "^max(0, width - length(s)) * s
function center(s, width)
pad = width - length(s)
if pad <= 0
return s
else
pad2 = div(pad, 2)
return " "^pad2 * s * " "^(pad - pad2)
end
end
parts = [split(rstrip(line, '$'), '$') for line in split(txt, '\n')]
max_widths = zeros(Int, maximum(length, parts))
for line in parts
for (i, word) in enumerate(line)
max_widths[i] = max(max_widths[i], length(word))
end
end
max_widths += 1 # separate cols by at least one space
for (label, justify) in (("Left", ljust), ("Right",rjust), ("Center",center))
println(label, " column-aligned output:")
for line in parts
for (j, word) in enumerate(line)
print(justify(word, max_widths[j]))
end
println()
end
println("-"^sum(max_widths))
end

4
Task/Anagrams-Deranged-anagrams/D/anagrams-deranged-anagrams-1.d
View file

@ -3,13 +3,13 @@ void main() {
std.functional, std.exception;
string[][const ubyte[]] anags;
foreach (w; "unixdict.txt".readText.split)
foreach (const w; "unixdict.txt".readText.split)
anags[w.dup.representation.sort().release.assumeUnique] ~= w;
anags
.byValue
.map!(words => cartesianProduct(words, words)
.filter!(ww => ww[].zip.all!q{ a[0] != a[1] })
.filter!(ww => ww[].equal!q{ a != b })
.array)
.filter!(not!empty)
.array

20
Task/Anagrams-Deranged-anagrams/D/anagrams-deranged-anagrams-2.d
View file

@ -1,29 +1,27 @@
import std.stdio, std.file, std.algorithm, std.string, std.range,
import std.stdio, std.file, std.algorithm, std.string, std.array,
std.functional, std.exception;
string[2][] findDeranged(string[] words) pure /*nothrow*/ {
//return words.pairwise.filter!(ww=> ww[].zip.all!q{a[0] != a[1]});
string[2][] findDeranged(in string[] words) pure nothrow {
// return words.pairwise.filter!(ww => ww[].equal!q{ a != b });
typeof(return) result;
foreach (immutable i, w1; words)
foreach (w2; words[i + 1 .. $])
if (zip(w1, w2).all!q{ a[0] != a[1] })
if (w1.representation.equal!q{ a != b }(w2.representation))
result ~= [w1, w2];
return result;
}
void main() {
Appender!(string[])[30] wClasses;
//foreach (word; "unixdict.txt".readText.splitter)
foreach (word; std.algorithm.splitter("unixdict.txt".readText))
wClasses[$ - word.length] ~= word;
foreach (const w; "unixdict.txt".readText.splitter)
wClasses[$ - w.length] ~= w;
"Longest deranged anagrams:".writeln;
foreach (words; wClasses[].map!q{ a.data }.filter!(not!empty)) {
foreach (const ws; wClasses[].map!q{ a.data }.filter!(not!empty)) {
string[][const ubyte[]] anags; // Assume ASCII input.
foreach (w; words)
foreach (immutable w; ws)
anags[w.dup.representation.sort().release.assumeUnique]~= w;
auto pairs = anags.byValue.map!findDeranged.joiner;
if (!pairs.empty)
return writefln(" %-(%s %)", pairs.front);
return writefln("Longest deranged: %-(%s %)", pairs.front);
}
}

2
Task/Anagrams-Deranged-anagrams/OCaml/anagrams-deranged-anagrams.ocaml
View file

@ -40,7 +40,7 @@ let () =
try Hashtbl.find h key
with Not_found -> []
in
Hashtbl.add h key (word::l);
Hashtbl.replace h key (word::l);
done with End_of_file ->
close_in ic;
let lst =

8
Task/Anagrams/Component-Pascal/anagrams-2.component
View file

@ -1,9 +1,9 @@
import std.stdio, std.algorithm, std.range, std.string, std.exception;
import std.stdio, std.algorithm, std.string, std.exception, std.file;
void main() {
string[][const ubyte[]] an;
foreach (w; "unixdict.txt".File.byLine(KeepTerminator.no))
an[w.dup.representation.sort().release.assumeUnique] ~= w.idup;
string[][ubyte[]] an;
foreach (w; "unixdict.txt".readText.splitLines)
an[w.dup.representation.sort().release.assumeUnique] ~= w;
immutable m = an.byValue.map!q{ a.length }.reduce!max;
writefln("%(%s\n%)", an.byValue.filter!(ws => ws.length == m));
}

19
Task/Anagrams/Elena/anagrams.elena
View file

@ -1,13 +1,14 @@
#define system.
#define system'collections.
#define extensions'text.
#define system'routines.
#define extensions.
#define extensions'text.
// --- Normalized ---
#symbol Normalized = &&:aLiteral
#symbol Normalized = (:aLiteral)
[
^ Summing new:(String new) foreach:(arrayControl sort:(stringControl toArray:aLiteral)) Literal.
^ Summing new:(String new) foreach:(arrayControl sort:(literalControl toArray:aLiteral)) literal.
].
// --- Program ---
@ -16,20 +17,20 @@
[
#var aDictionary := Dictionary new.
textFileControl forEachLine:"unixdict.txt" &do: &&:aWord
textFileControl forEachLine:"unixdict.txt" &do: aWord
[
#var aKey := Normalized eval:aWord.
#var anItem := aDictionary @ aKey.
#var aKey := Normalized:aWord.
#var anItem := aDictionary getAt &key:aKey.
nil == anItem ?
[
anItem := List new.
aDictionary setAt:aKey:anItem.
aDictionary set &key:aKey &value:anItem.
].
anItem += aWord.
].
listControl sort:aDictionary &with: &&:aFormer:aLater [ aFormer Value Count > aLater Value Count ].
listControl sort:aDictionary &with: (:aFormer:aLater) [ aFormer value length > aLater value length ].
listControl foreach:aDictionary &top:20 &do: &&:aPair [ console writeLine:(ListPresenter new:(aPair Value)) ].
controlEx foreach:aDictionary &top:20 &do: aPair [ consoleEx writeLine:(aPair value) ].
].

24
Task/Anagrams/Go/anagrams-1.go
View file

@ -1,22 +1,30 @@
package main
import (
"bytes"
"fmt"
"io/ioutil"
"net/http"
"sort"
"strings"
)
func main() {
b, err := ioutil.ReadFile("unixdict.txt")
r, err := http.Get("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
if err != nil {
fmt.Println(err)
return
}
b, err := ioutil.ReadAll(r.Body)
r.Body.Close()
if err != nil {
fmt.Println(err)
return
}
var ma int
m := make(map[string][]string)
for _, word := range strings.Split(string(b), "\n") {
bs := byteSlice(word)
var bs byteSlice
m := make(map[string][][]byte)
for _, word := range bytes.Fields(b) {
bs = append(bs[:0], byteSlice(word)...)
sort.Sort(bs)
k := string(bs)
a := append(m[k], word)
@ -27,13 +35,13 @@ func main() {
}
for _, a := range m {
if len(a) == ma {
fmt.Println(a)
fmt.Printf("%s\n", a)
}
}
}
type byteSlice []byte
func (b byteSlice) Len() int { return len(b) }
func (b byteSlice) Swap(i, j int) { b[i], b[j] = b[j], b[i] }
func (b byteSlice) Len() int { return len(b) }
func (b byteSlice) Swap(i, j int) { b[i], b[j] = b[j], b[i] }
func (b byteSlice) Less(i, j int) bool { return b[i] < b[j] }

52
Task/Anagrams/Nimrod/anagrams.nimrod Normal file
View file

@ -0,0 +1,52 @@
import tables
proc sort(s: string): string =
var
i,j: int
t: char
result = s
for i in 0 .. result.len - 1:
j = i
t = result[j]
while(j > 0) and (result[j - 1] > t):
result[j] = result[j - 1]
dec(j)
result[j] = t
# end sort
proc maxCount(an: TTable[string,seq[string]]): int =
result = 0
for v in an.values:
if v.len > result:
result = v.len
#end maxCount
proc showAnagrams(s: seq[string]) =
for v in s:
write(stdout,v)
write(stdout," ")
writeln(stdout,"")
#end showAnagrams
proc processFile: TTable[string,seq[string]] =
var
fd: TFile
sline,line: string
result = initTable[string,seq[string]]()
if Open(fd,"unixdict.txt"):
while not EndOfFile(fd):
line = fd.readLine()
sline = sort(line)
if result.hasKey(sline):
result[sline] = result[sline] & line
else:
result[sline] = @[line]
var
anagrams:TTable[string,seq[string]] = processFile()
max = anagrams.maxCount
for v in anagrams.values:
if v.len == max: showAnagrams(v)

2
Task/Anagrams/OCaml/anagrams.ocaml
View file

@ -23,7 +23,7 @@ let () =
try Hashtbl.find h k
with Not_found -> []
in
Hashtbl.add h k (w::l);
Hashtbl.replace h k (w::l);
done with End_of_file -> ();
let n = Hashtbl.fold (fun _ lw n -> max n (List.length lw)) h 0 in
Hashtbl.iter (fun _ lw ->

14
Task/Anagrams/Ruby/anagrams-2.rb
View file

@ -1,14 +1,4 @@
require 'open-uri'
anagram = nil
open('http://www.puzzlers.org/pub/wordlists/unixdict.txt') do |f|
anagram = f.read.split.group_by {|s| s.each_char.sort}
end
count = anagram.each_value.map {|ana| ana.length}.max
anagram.each_value do |ana|
if ana.length >= count
p ana
end
end
anagrams = open('http://www.puzzlers.org/pub/wordlists/unixdict.txt'){|f| f.read.split.group_by{|w| w.each_char.sort} }
anagrams.values.group_by(&:size).max.last.each{|group| puts group.join(", ") }

3
Task/Animate-a-pendulum/Factor/animate-a-pendulum.factor
View file

@ -14,8 +14,7 @@ CONSTANT: theta0 0.5
: theta ( -- theta ) current-time omega0 * cos theta0 * ;
: relative-xy ( theta l -- xy )
[ [ sin ] [ cos ] bi ]
[ [ * ] curry ] bi* bi@ 2array ;
swap [ sin * ] [ cos * ] 2bi 2array ;
: theta-to-xy ( origin theta l -- xy ) relative-xy v+ ;
TUPLE: pendulum-gadget < gadget alarm ;

2
Task/Anonymous-recursion/00DESCRIPTION
View file

@ -1,6 +1,6 @@
While implementing a recursive function, it often happens that we must resort to a separate "helper function" to handle the actual recursion.
This is usually the case when directly calling the current function would waste too many resources (stack space, execution time), cause unwanted side-effects, and/or the function doesn't have the right arguments and/and return values.
This is usually the case when directly calling the current function would waste too many resources (stack space, execution time), cause unwanted side-effects, and/or the function doesn't have the right arguments and/or return values.
So we end up inventing some silly name like "foo2" or "foo_helper". I have always found it painful to come up with a proper name, and see a quite some disadvantages:

2
Task/Anonymous-recursion/Deja-Vu/anonymous-recursion-1.djv
View file

@ -15,4 +15,4 @@ Y
set :fibo
for j range 0 10:
print fibo j
!print fibo j

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