99 bottles of beer
Richard.Suchenwirth
the admittedly silly song
99 bottles of beer on the wall, 99 bottles of beer.
Take one down, pass it around,
98 bottles of beer.
... (downto 0)
has to be produced by a program. Tim Robinson (timt...@ionet.net)
exhibits
a collection of presently 227 programming languages (some with >1
example)
in http://www.ionet.net/~timtroyr/funhouse/beer.html. Tcl is
represented there with a program by Don Libes
http://www.ionet.net/~timtroyr/funhouse/beer/beer_s_z.html#tcl
, but I think the following is sufficiently different to be also
considered:
proc s {n} {concat $n bottle[expr $n>1?"s":""] of beer}
proc bob {n} {if $n {return "
[s $n] on the wall, [s $n].
Take one down, pass it around,
[s [incr n -1]].
[bob $n]"}}
bob 99
If not for the fun, this seems to be a good playground on which to
compare languages, and exercise a language to its limits -- and could
also bring some diversion into comp.lang.tcl, besides exec "ls *.c"
problems ;-)
--
Schoene Gruesse/best regards, Richard Suchenwirth -- tel. +49-7531-86
2703
> RC DT2, Siemens Electrocom GmbH, Buecklestr. 1-5, D-78467 Konstanz, Germany
> My opinions were not necessarily, or will not necessarily be, mine.
Stefaan A Eeckels
"Richard.Suchenwirth" <Richard.S...@kst.siemens.de> writes:
<SNIP>
>
> proc s {n} {concat $n bottle[expr $n>1?"s":""] of beer}
> proc bob {n} {if $n {return "
> [s $n] on the wall, [s $n].
> Take one down, pass it around,
> [s [incr n -1]].
> [bob $n]"}}
> bob 99
>
> If not for the fun, this seems to be a good playground on which to
> compare languages, and exercise a language to its limits -- and could
> also bring some diversion into comp.lang.tcl, besides exec "ls *.c"
> problems ;-)
One minor nit to pick: it generates:
0 bottle of beer
so I changed it a little:
proc s {n} {concat $n bottle[expr $n>1||$n==0?"s":""] of beer}
proc bob {n} {if $n {return "
etc.
Nice.
--
Stefaan
--
PGP key available from PGP key servers (http://www.pgp.net/pgpnet/)
___________________________________________________________________
Perfection is reached, not when there is no longer anything to add,
but when there is no longer anything to take away. -- Saint-Exupéry
Hume Smith
>so I changed it a little:
>
>proc s {n} {concat $n bottle[expr $n>1||$n==0?"s":""] of beer}
gnurk....
proc s {n} {concat $n bottle[expr {$n-1?{s}:{}}] of beer}
Darren New
> proc s {n} {concat $n bottle[expr {$n-1?{s}:{}}] of beer}
I don't think you're *supposed* to be cryptic.
proc s {n} {concat $n bottle[expr {$n!=1?{s}:{}}] of beer}
--
Darren New / Senior Software Architect / MessageMedia, Inc.
San Diego, CA, USA (PST). Cryptokeys on demand.
There is no "best" programming language. Only "least worst."
John Ellson
>
> I just today discovered the "99 bottles of beer" game, where the text of
> the admittedly silly song
> 99 bottles of beer on the wall, 99 bottles of beer.
> ... (downto 0)
> has to be produced by a program. Tim Robinson (timt...@ionet.net) exhibits
> a collection of presently 227 programming languages (some with >1 example)
> in http://www.ionet.net/~timtroyr/funhouse/beer.html. Tcl is
> represented there with a program by Don Libes
> http://www.ionet.net/~timtroyr/funhouse/beer/beer_s_z.html#tcl
> , but I think the following is sufficiently different to be also considered:
>
> proc bob {n} {if $n {return "
> [s $n] on the wall, [s $n].
> Take one down, pass it around,
> [s [incr n -1]].
> [bob $n]"}}
> bob 99
Oh what fun :-)
Here's 11 characters trimmed off, but it probably doesn't work
in tcl7.5 because of the "subst" which was worth one character
over "return". I didn't actually save anything with "if"
instead of "expr", but it looks less like line noise.
proc s n {concat $n bottle[if $n-1 {list s}] of beer}
proc b n {if $n {subst "
[s $n] on the wall, [s $n].
Take one down, pass it around,
[s [incr n -1]].
[b $n]"}}
b 99
John Ellson
John Ellson
in three lines plus header comment. The code part is actually 2 characters
longer because of the \n
# Bottles of Tcl beer, by: Richard Suchenwirth and others on comp.lang.tcl
proc s n {concat $n bottle[if $n-1 {list s}] of beer};proc b n {if $n {subst "
[s $n] on the wall, [s $n].\nTake one down, pass it around,\n[s [incr n -1]].
Hume Smith
>Hume Smith wrote:
>> proc s {n} {concat $n bottle[expr {$n-1?{s}:{}}] of beer}
>I don't think you're *supposed* to be cryptic.
>proc s {n} {concat $n bottle[expr {$n!=1?{s}:{}}] of beer}
well, if we're into shortness like the other branch of this thread is, that was
worth a point.
--
<URL:http://www.glinx.com/~hclsmith/>
Hume Smith
>Darren New <dn...@messagemedia.com> wrote:
>>Hume Smith wrote:
>>> proc s {n} {concat $n bottle[expr {$n-1?{s}:{}}] of beer}
>
>>I don't think you're *supposed* to be cryptic.
>
>>proc s {n} {concat $n bottle[expr {$n!=1?{s}:{}}] of beer}
>
>well, if we're into shortness like the other branch of this thread is, that was
>worth a point.
of course, by that defense, i should strip off a pair of braces. and surely we
can do something with that concat...
--
<URL:http://www.glinx.com/~hclsmith/>
Richard.Suchenwirth
Good for a signature, but I think it couldn't impress a Perlist - and
someone who is to maintain that code. After reading dozens of 99BoB
implementations, I noticed that the spec is not exactly tight, but quite
some authors added features:
- "0 bottles" spelled as "No more bottles"
- when only 1 bottle left, "Take it down" instead of "Take one down"
- the last line of each verse should again end with "on the wall"
- added an ultimate (cyclic) verse about buying more beer
- plus many specials (e.g. in Ada, Expect)
So here's my v2.3:
proc s {n {w 0}} {
concat [expr $n?$n:"no more"] bottle[expr $n!=1?"s":""] of beer\
[expr $w?" on the wall":{}]
}
proc b {{n 99}} {if $n {subst "
[s $n 1], [s $n].\nTake [expr $n>1?{one}:{it}] down, pass it around,
[s [incr n -1] 1].\n[b $n]"} else {subst "
[s 0 1], [s 0].\nGo to the store, buy some more, [s 99 1]."}}
Don Libes
> I just today discovered the "99 bottles of beer" game, where the text of
> the admittedly silly song
> 99 bottles of beer on the wall, 99 bottles of beer.
> ... (downto 0)
> has to be produced by a program. Tim Robinson (timt...@ionet.net)
> exhibits
> a collection of presently 227 programming languages (some with >1
> example)
> in http://www.ionet.net/~timtroyr/funhouse/beer.html. Tcl is
> represented there with a program by Don Libes
> http://www.ionet.net/~timtroyr/funhouse/beer/beer_s_z.html#tcl
> , but I think the following is sufficiently different to be also
> considered:
You should also check out the Expect version at the same web site. It
simulates a human typing "99 bottles ..." while drinking 99 bottles.
As the drinking progresses, the typing becomes more erratic both in
terms of speed and spelling errors. And sometimes, it entirely loses
its place. (My chance to show off the "send -h" feature.)
Don
Richard.Suchenwirth
proc en:num {n {optional 0}} {
#---------------- English spelling for integer numbers
if {[catch {set n [expr $n]}]} {return $n}
if {$optional && $n==0} {return ""}
array set dic {
0 zero 1 one 2 two 3 three 4 four 5 five 6 six 7 seven
8 eight 9 nine 10 ten 11 eleven 12 twelve
}
if [info exists dic($n)] {return $dic($n)}
foreach {value word} {1000000 million 1000 thousand 100 hundred} {
if {$n>=$value} {
return "[en:num $n/$value] $word [en:num $n%$value 1]"
}
} ;#--------------- composing between 13 and 99...
if $n>=20 {
set res $dic([expr $n/10])ty
if $n%10 {append res -$dic([expr $n%10])}
} else {
set res $dic([expr $n-10])teen
} ;#----------- fix over-regular compositions
regsub "twoty" $res "twenty" res
regsub "threet" $res "thirt" res
regsub "fivet" $res "fift" res
regsub "eightt" $res "eight" res
return $res
}
proc s {n {w 0}} {
concat [expr $n?"[en:num $n]":"no more"]\
bottle[expr $n!=1?"s":""] of beer\
[expr $w?" on the wall":{}]
}
proc string:title s {
return [string toupper [string index $s 0]][string range $s 1 end]
}
proc bob {n} {if $n {subst "
[string:title [s $n 1]], [s $n].
Take [expr $n>1?{one}:{it}] down, pass it around,
[s [incr n -1] 1].\n[bob $n]"} else {subst "
Go to the store, buy some more,
[s 99 1]."}}
puts [bob 99]
Jeffrey Hobbs
> Enhanced Bottles Song (v2.4), now with English number name generation:
An adaption and extension of Richard's to add the ability to have
it give the numbers in roman numerals, with 8.1.1 string features:
proc roman {x args} {
set result ""
foreach elem {
{ 1000 M } { 900 CM } { 500 D } { 400 ID }
{ 100 C } { 90 IC } { 50 L } { 10 X }
{ 9 IX } { 5 V } { 4 IV } { 1 I }
} {
set digit [lindex $elem 0]
set roman [lindex $elem 1]
while {$x >= $digit} {
append result $roman
incr x -$digit
}
}
return $result
}
proc english {n {optional 0}} {
#---------------- English spelling for integer numbers
if {$optional && $n==0} {return ""}
if {![info exists ::dic]} {
array set ::dic {
0 zero 1 one 2 two 3 three 4 four 5 five 6 six 7 seven
8 eight 9 nine 10 ten 11 eleven 12 twelve
}
set ::map [list twoty twenty threet thirt fivet fift eightt eight \
fourty forty]
}
if {[info exists ::dic($n)]} {return $::dic($n)}
foreach {value word} {1000000 million 1000 thousand 100 hundred} {
if {$n >= $value} {
return "[english [expr {$n/$value}]]\
$word [english [expr {$n%$value}] 1]"
}
} ;#--------------- composing between 13 and 99...
if {$n>=20} {
set res $::dic([expr {$n/10}])ty
if {$n%10} {append res -$::dic([expr {$n%10}])}
} else {
set res $::dic([expr {$n-10}])teen
} ;#----------- fix over-regular compositions
return [string map $::map $res]
}
proc s {t n {w 0}} {
return "[expr {$n?[$t $n $w]:{no more}}] bottle[expr {$n!=1?{s}:{}}]\
of beer[expr {$w?{ on the wall}:{}}]"
}
proc bob {n {t english}} {if {$n>0} {return "
[expr {[string eq roman $t]?[s $t $n 1]:[string tot [s $t $n 1]]}], [s $t
$n].
Take [expr {$n>1?{one}:{it}}] down, pass it around,
[s $t [incr n -1] 1].\n[bob $n $t]"} else {return "
Go to the store, buy some more,\n[s $t 99 1]."}}
** Jeffrey Hobbs jeff.hobbs @SPAM acm.org **
** I'm really just a Tcl-bot My opinions are MY opinions **
Richard.Suchenwirth
Also: You introduced global arrays that are initialized only once.
That's definitely a better idea in a repeated task like 99bob.
But timing isn't that terrible: it took 1.9 seconds on a Sun 20 to
produce all 99 verses with English numbers. I used a global list in
another homebrew helper, the morse coder/decoder (see below), but I'm
not quite sure about "cluttering?" the global namespace. Thanks anyway,
and here's
proc morse {s} {
global _morse
if ![info exists _morse] {
set _morse {
A ._ Ä ._._ B _... C _._. D _.. E . F .._.
G __. H .... I .. J .___ K _._ L ._.. M __
N _. O ___ Ö ___. P .__. Q __._ R ._. S ...
T _ U .._ Ü ..__ V ..._ W .__ X _.._ Y _.__ Z __..
0 _____ 1 .____ 2 ..___ 3 ...__ 4 ...._ 5 .....
6 _.... 7 __... 8 ___.. 9 ____.
}
}
set res ""
if [regexp {^[._ ]+$} $s] {
regsub -all { +} $s " B " s
foreach i [split $s] {
if {$i==""} continue
if {$i=="B"} {append res " "; continue}
set ix [lsearch $_morse $i]
if $ix>=0 {
append res [lindex $_morse [expr $ix-1]]
} else {append res ?}
}
} else {
foreach i [split [string toupper $s] ""] {
if {$i==""} continue
if {$i==" "} {append res " "; continue}
set ix [lsearch $_morse $i]
if $ix>=0 {
append res "[lindex $_morse [expr $ix+1]] "
}
}
}
return $res
}
Just for impressing people, one could translate the 99 bottles, with
Roman numerals, to morse...
puts [morse [bob 99]]