This commit is contained in:
Ingy döt Net 2013-04-09 15:58:49 -07:00
parent 80737d5a6a
commit fc81c9e6d0
45 changed files with 169 additions and 178 deletions

View File

@ -1,11 +1,14 @@
0815:
360 Assembly:
4D:
ext: 4d
A+:
ABAP:
ACL2:
ActionScript:
ext: as
Ada:
AWK:
ext: awk
B:
ext: b
Babel:
ext: pb
BASIC:
@ -13,13 +16,11 @@ BASIC:
Befunge:
ext: bf
C:
ext: c
Clojure:
ext: clj
CoffeeScript:
ext: coffee
Dylan:
ext: dylan
Eiffel:
ext: e
Erlang:
@ -29,25 +30,20 @@ Forth:
Fortran:
ext: f
Go:
ext: go
Haskell:
ext: hs
Java:
ext: java
JavaScript:
ext: js
LaTeX:
ext: tex
Lua:
ext: lua
Perl:
ext: pl
PHP:
ext: php
PicoLisp:
ext: l
PIR:
ext: pir
Prolog:
ext: pro
Python:
@ -57,20 +53,15 @@ R:
Racket:
ext: rkt
REXX:
ext: rexx
Ruby:
ext: rb
Sather:
ext: sa
Scala:
ext: scala
Scheme:
ext: ss
Smalltalk:
ext: st
SNUSP:
ext: snusp
Tcl:
ext: tcl
Turing:
ext: turing

View File

@ -1,3 +1,3 @@
{{stub}}{{language|4D}}{{IDE}}'''4D''' (or '''4th Dimension''') is a database management system and [[:Category:Integrated Development Environments|integrated development environment]] authored by Laurent Ribardière in 1984.
{{stub}}{{language|4D}}{{IDE}}'''4D''' (or '''4th Dimension''') is a database management system and [[:Category:Integrated Development Environments|integrated development environment]] authored by Laurent Ribardière in 1984.
==Citations==
*[[wp:4th_Dimension_%28Software%29|Wikipedia:4th Dimension (Software)]]

View File

@ -44,7 +44,7 @@ The CoffeeScript compiler has been written in CoffeeScript since version 0.5, an
# Github. "[http://github.com/repositories Interesting Repositories]", Github, Nov 10, 2010.
# Carson, Ryan. "[http://thinkvitamin.com/mobile/new-rails-like-framework-from-37signals-for-html5-mobile-apps/ New Rails-like Framework from 37signals for HTML5 Mobile Apps]", Think Vitamin blog, Nov 8, 2010.
# Hagenburger, Nico. "[http://www.hagenburger.net/TALKS/rails-3.1-frontend-performance.html Rails 3.1 – A Sneak Preview]", presentation for [http://railscamp-hamburg.de/ Railscamp Hamburg] on Oct 23, 2010.
# Hagenburger, Nico. "[http://www.hagenburger.net/TALKS/rails-3.1-frontend-performance.html Rails 3.1 A Sneak Preview]", presentation for [http://railscamp-hamburg.de/ Railscamp Hamburg] on Oct 23, 2010.
# Ashkenas, Jeremy. "[http://github.com/jashkenas/coffee-script/issues/830 The Plan for 1.0]", Github issue tracker, Nov 4, 2010.
== External links ==

View File

@ -11,7 +11,7 @@
Lua is commonly described as a "multi-[[:Category:Programming Paradigms|paradigm]]" language, providing a small set of general features that can be extended to fit different problem types, rather than providing a more complex and rigid specification to match a single paradigm. Lua, for instance, does not contain explicit support for inheritance, but allows it to be implemented relatively easily with metatables. Similarly, Lua allows programmers to implement namespaces, classes, and other related features using its single table implementation; first class functions allow the employment of many powerful techniques from functional programming; and full lexical scoping allows fine-grained information hiding to enforce the principle of least privilege.
In general, Lua strives to provide flexible meta-features that can be extended as needed, rather than supply a feature-set specific to one programming paradigm. As a result, the base language is light—in fact, the full reference interpreter is only about 150KB compiled—and easily adaptable to a broad range of applications.
In general, Lua strives to provide flexible meta-features that can be extended as needed, rather than supply a feature-set specific to one programming paradigm. As a result, the base language is light—in fact, the full reference interpreter is only about 150KB compiled—and easily adaptable to a broad range of applications.
==Citations==
* [[wp:Lua_%28programming_language%29|Wikipedia:Lua (programming language)]]

View File

@ -24,7 +24,7 @@ It is a language that combines
Ruby is a language of careful balance. Its creator blended parts of his favorite languages ([[Perl]], [[Smalltalk]], [[Eiffel]], [[Ada]], and [[Lisp]]) to form a new language that balances [[functional programming]] with [[imperative programming]].
He has often said that he is “trying to make Ruby natural, not simple,” in a way that mirrors life.
He has often said that he is “trying to make Ruby natural, not simple,” in a way that mirrors life.
Since its public release in 1995, Ruby has drawn devoted coders worldwide. In 2006, Ruby achieved mass acceptance. The [http://www.tiobe.com/tpci.htm TIOBE] index, which measures the growth of programming languages, ranks Ruby as #11 among programming languages worldwide. Much of the growth is attributed to the popularity of software written in Ruby, particularly the Rails web framework.

View File

@ -27,7 +27,7 @@ Tcl is known to be supported under a variety of popular operating systems, inclu
The Tcl language has been implemented in multiple lower-level languages. The most common one is '''[[libtcl]]''', written in [[C]], which is the engine used to power [[tclsh]] and [[wish]], but others exist. Notably, these include [[Jacl]] and [[Eagle]], which implement Tcl in [[Java]] and [[C sharp|C#]] respectively.
Its creator, John Ousterhout, wrote about it:
:''“I got the idea for Tcl while on sabbatical leave at DEC's Western Research Laboratory in the fall of 1987. I started actually implementing it when I got back to Berkeley in the spring of 1988; by summer of that year it was in use in some internal applications of ours, but there was no Tk. The first external releases of Tcl were in 1989, I believe. I started implementing Tk in 1989, and the first release of Tk was in 1991.”''
:''I got the idea for Tcl while on sabbatical leave at DEC's Western Research Laboratory in the fall of 1987. I started actually implementing it when I got back to Berkeley in the spring of 1988; by summer of that year it was in use in some internal applications of ours, but there was no Tk. The first external releases of Tcl were in 1989, I believe. I started implementing Tk in 1989, and the first release of Tk was in 1991.''
The principal pre-built distributions of Tcl are all based on [[libtcl]]; the main ones are [[ActiveTcl]] from ActiveState, and [[tclkit]] from Equi4 Software ''et al''. Older versions of the language are distributed as part of Apple's OSX and all Linux distributions.
@ -35,25 +35,25 @@ The principal pre-built distributions of Tcl are all based on [[libtcl]]; the ma
===Grammar===
Note that this is a simplified language grammar, and it is normal to think of the language at a higher level where these differences don't show.
<br clear=all>
script '''::=''' command'''? ((''' “''\n''” '''|''' “'';''” ''')''' script ''')'''
command '''::=''' “''#''” characters “''\n''” <span style="color:grey">/* comment */</span>
script '''::=''' command'''? ((''' “''\n''” '''|''' “'';''” ''')''' script ''')'''
command '''::=''' “''#''” characters “''\n''” <span style="color:grey">/* comment */</span>
'''|''' word '''(''' space word ''')*''' <span style="color:grey">/* sequence of space-separated words;
* first is command name */</span>
'''|''' <span style="color:grey">/* empty */</span>
word '''::=''' “''{*}''”'''?''' “''{''” characters “''}''” <span style="color:grey">/* braces must be balanced */</span>
'''|''' “''{*}''”'''?''' “''"''” charSubsts “''"''” <span style="color:grey">/* double-quotes must be balanced */</span>
'''|''' “''{*}''”'''?''' charSubsts
charSubsts '''::=''' “''[''” script “'']''” charSubsts'''?''' <span style="color:grey">/* brackets must be balanced */</span>
'''|''' “''$''” varName charSubsts'''?'''
'''|''' “''${''” varName “''}''” charSubsts'''?'''
'''|''' “''\\''” escapeSequence charSubsts''?''
word '''::=''' “''{*}''”'''?''' “''{''” characters “''}''” <span style="color:grey">/* braces must be balanced */</span>
'''|''' “''{*}''”'''?''' “''"''” charSubsts “''"''” <span style="color:grey">/* double-quotes must be balanced */</span>
'''|''' “''{*}''”'''?''' charSubsts
charSubsts '''::=''' “''[''” script “'']''” charSubsts'''?''' <span style="color:grey">/* brackets must be balanced */</span>
'''|''' “''$''” varName charSubsts'''?'''
'''|''' “''${''” varName “''}''” charSubsts'''?'''
'''|''' “''\\''” escapeSequence charSubsts''?''
'''|''' ordinaryChar charSubsts''?''
The syntax of the language is defined more exactly in the [http://www.tcl.tk/man/tcl8.5/TclCmd/Tcl.htm Tcl(n)] manual page.
===Conceptual Command Syntax===
Though formally not part of the language syntax, the syntactic style of the language's standard commands mostly follow a few basic syntactic principles:
* Commands are variadic, and frequently accept arbitrary numbers of arguments.
* Commands that take options will prefix the option name with a single ASCII hyphen, “-”, and if a value parameter to the option is required, that parameter will be in a subsequent argument to the option name.
* Commands that take options will prefix the option name with a single ASCII hyphen, “-”, and if a value parameter to the option is required, that parameter will be in a subsequent argument to the option name.
* Option names are not single character long strings after removing the hyphen (except in rare cases) and <code>getopt</code>-style argument combination is never supported.
* Commands perform callbacks by evaluating a caller-provided Tcl script.
** During-execution callback scripts are evaluated in the context of their caller.
@ -98,19 +98,19 @@ The following commands are simply normal commands, and can be renamed, deleted,
'''uplevel''' ?''level''? ''arg''...
:Concatenate the arguments and evaluate them as a script in the stack frame given by ''level'' (or the stack frame that called the current procedure if that is omitted). Due to syntactic ambiguities, it is recommended that the ''level'' always be specified explicitly.
==== From Tcl 8.5 ====
'''apply''' ''lambdaTerm arg…''
'''apply''' ''lambdaTerm arg''
:Applies a lambda term to zero or more arguments. Lambda terms are two- or three-element tuples, the first element being the formal parameter description, the second being the script that implements the lambda (just as with '''proc''') and the optional third being the context namespace (with the default being the global namespace).
'''dict''' ''subcommand'' …
'''dict''' ''subcommand''
:Manipulates dictionaries, values that describe a (sparse) mapping from arbitrary keys to arbitrary values (well, so long as both are themselves values).
==== From Tcl 8.6 ====
'''coroutine''' ''name command arg…''
'''coroutine''' ''name command arg''
:Create a coroutine called ''name'', which is implemented by the execution of ''command'' together with any supplied arguments. The ''name'' is the name of a command that will be used to resume the coroutine.
'''yield''' ?''value''?
:Yield from a coroutine, with optional value (empty if not supplied). Result will be the optional resumption argument to the coroutine's command.
'''tailcall''' ''command arg…''
'''tailcall''' ''command arg''
:Stops the execution of the current context and replaces it with a call to the given ''command'' with any arguments.
'''oo::class create''' ''name body''
:Creates a class called ''name'' with definition ''body''. Instances of ''name'' are created with “''name'' '''new''' ''arg…''” and “''name'' '''create''' ''instanceName arg…''”. (Note that the syntax for '''oo::class''' is a consequence of this.)
:Creates a class called ''name'' with definition ''body''. Instances of ''name'' are created with “''name'' '''new''' ''arg…''” and “''name'' '''create''' ''instanceName arg…''”. (Note that the syntax for '''oo::class''' is a consequence of this.)
==Language Semantics==
===Value Model===

View File

@ -15,5 +15,5 @@ say 'no more bottles of beer.' /*so sad ... */
say 'Go to the store and buy some more,' /*replenishment of the beer.*/
say '99 bottles of beer on the wall.' /*All is well in the tavern.*/
exit /*we're done & also sloshed.*/
/*───────────────────────────────────S subroutine───────────────────────*/
/*───────────────────────────────────S subroutine───────────────────────*/
s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/

View File

@ -6,13 +6,13 @@ high=24
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

View File

@ -13,13 +13,13 @@ numeric digits 100 /*have REXX to use up to 100 digit integers.*/
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

View File

@ -11,13 +11,13 @@ high=24
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,high)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

View File

@ -14,20 +14,20 @@ wL.=0 /*number of words of length L. */
@s.words=@@s.L._ /*and also, sorted length L vers.*/
end /*j*/
a.= /*all the anagrams for word X. */
say copies('─',30) words 'words in the dictionary file: ' ifid
say copies('',30) words 'words in the dictionary file: ' ifid
n.=0 /*number of anagrams for word X. */
do j=1 for words /*process the usable words found.*/
x=@.j; Lx=length(x); xs=@s.j /*get some vital statistics for X*/
do k=1 for wL.Lx /*process all the words of len L.*/
if xs\==@@s.Lx.k then iterate /*is this a true anagram of X ? */
if x==@@.Lx.k then iterate /*skip doing anagram on itself. */
n.j=n.j+1; a.j=a.j @@.Lx.k /*bump counter, add ──► anagrams.*/
n.j=n.j+1; a.j=a.j @@.Lx.k /*bump counter, add ──► anagrams.*/
end /*k*/
end /*j*/
m=n.1 /*assume first (len=1) is largest*/
do j=2 to words; m=max(m,n.j); end /*find the maximum anagram count.*/
do k=1 for words; if n.k==m then if word(a.k,1)>@.k then say @.k a.k; end
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ESORT───────────────────────────────*/
/*──────────────────────────────────ESORT───────────────────────────────*/
esort:procedure expose !.;h=!.0;do while h>1;h=h%2;do i=1 for !.0-h;j=i;k=h+i
do while !.k<!.j;t=!.j;!.j=!.k;!.k=t;if h>=j then leave;j=j-h;k=k-h;end;end;end;return

View File

@ -9,13 +9,13 @@
(define (hash-words words)
(for/fold ([ws-hash (hash)]) ([w words])
(hash-update ws-hash
(list->string (sort (string->list w) < #:key (λ (c) (char->integer c))))
(λ (ws) (cons w ws))
(λ () '()))))
(list->string (sort (string->list w) < #:key (λ (c) (char->integer c))))
(λ (ws) (cons w ws))
(λ () '()))))
(define (get-maxes h)
(define max-ws (apply max (map length (hash-values h))))
(define max-keys (filter (λ (k) (= (length (hash-ref h k)) max-ws)) (hash-keys h)))
(map (λ (k) (hash-ref h k)) max-keys))
(define max-keys (filter (λ (k) (= (length (hash-ref h k)) max-ws)) (hash-keys h)))
(map (λ (k) (hash-ref h k)) max-keys))
(get-maxes (hash-words (get-lines "http://www.puzzlers.org/pub/wordlists/unixdict.txt")))

View File

@ -9,5 +9,5 @@ say 'element 50 is:' a(50)
say 'element 3000 is:' a(3000)
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────A subroutine────────────────────────*/
/*──────────────────────────────────A subroutine────────────────────────*/
a: _a_ = arg(1); return a._a_

View File

@ -19,7 +19,7 @@ a.civet="A.K.A.: toddycats"
characters. To illustrate:
--------------------------------------------------------------------------*/
stuff=')g.u.t.s( or ½ of an intestine!'
stuff=')g.u.t.s( or ½ of an intestine!'
a.stuff=44
/*--------------------------------------------------------------

View File

@ -1,5 +1,5 @@
'''Task''':
* Generate a string with <math>\mathrm{N}</math> opening brackets (“<code>[</code>”) and <math>\mathrm{N}</math> closing brackets (“<code>]</code>”), in some arbitrary order.
* Generate a string with <math>\mathrm{N}</math> opening brackets (“<code>[</code>”) and <math>\mathrm{N}</math> closing brackets (“<code>]</code>”), in some arbitrary order.
* Determine whether the generated string is ''balanced''; that is, whether it consists entirely of pairs of opening/closing brackets (in that order), none of which mis-nest.
'''Examples''':

View File

@ -21,17 +21,17 @@ call teller
count=0
nested=0
do j=1 /*generate lots of permutations. */
q=translate(strip(x2b(d2x(j)),'L',0),"][",01) /*convert──►[].*/
q=translate(strip(x2b(d2x(j)),'L',0),"][",01) /*convert──►[].*/
if countstr(']',q)\==countstr('[',q) then iterate /*compliant?*/
call checkBal q
if length(q)>20 then leave /*done all 20-char possibilities?*/
end
/*───────────────────────────────────TELLER subroutine──────────────────*/
/*───────────────────────────────────TELLER subroutine──────────────────*/
teller: say
say count " expressions were checked, " nested ' were balanced, ',
count-nested " were unbalanced."
return
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
checkBal: procedure expose nested count; parse arg y; count=count+1
nest=0
do j=1 for length(y); _=substr(y,j,1) /*pick off character.*/
@ -43,16 +43,16 @@ nest=0
end /*j*/
nested=nested + (nest==0)
return nest==0
/* ┌──────────────────────────────────────────────────────────────────┐
│ COUNTSTR counts the number of occurances of a string (or char)│
│ within another string (haystack) without overlap. If either arg │
│ is null, 0 (zero) is returned. To make the subroutine case │
│ insensative, change the PARSE ARG ... statement to ARG ... │
│ Example: yyy = 'The quick brown fox jumped over the lazy dog.' │
│ zz = countstr('o',yyy) /*ZZ will be set to 4 */ │
│ Note that COUNTSTR is also a built-in function of the newer │
│ REXX interpreters, and the result should be identical. Checks │
│ could be added to validate if 2 or 3 arguments are passed. │
└──────────────────────────────────────────────────────────────────┘ */
/* ┌──────────────────────────────────────────────────────────────────┐
COUNTSTR counts the number of occurances of a string (or char)
within another string (haystack) without overlap. If either arg
is null, 0 (zero) is returned. To make the subroutine case
insensative, change the PARSE ARG ... statement to ARG ...
Example: yyy = 'The quick brown fox jumped over the lazy dog.'
zz = countstr('o',yyy) /*ZZ will be set to 4 */
Note that COUNTSTR is also a built-in function of the newer
REXX interpreters, and the result should be identical. Checks
could be added to validate if 2 or 3 arguments are passed.
*/
countstr: procedure; parse arg n,h,s; if s=='' then s=1; w=length(n)
do r=0 until _==0; _=pos(n,h,s); s=_+w; end; return r

View File

@ -23,13 +23,13 @@ q=']]][[[[]' ; call checkBal q; say yesno.result q
say yesno.result q
end
exit
/*───────────────────────────────────PAND subroutine────────────────────*/
/*───────────────────────────────────PAND subroutine────────────────────*/
pand: p=random(0,1); return p || \p
/*───────────────────────────────────RAND subroutine────────────────────*/
/*───────────────────────────────────RAND subroutine────────────────────*/
rand: pp=pand(); pp=pand()pp; pp=copies(pp,arg(1))
i=random(2,length(pp)); pp=left(pp,i-1)substr(pp,i)
return pp
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
checkBal: procedure expose @.; arg y /*check for balanced brackets [] */
nest=0; if @.y then return '-1' /*already done this expression ? */
@.y=1 /*indicate expression processed. */

View File

@ -1,4 +1,4 @@
[[wp:Balanced ternary|Balanced ternary]] is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary integer is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 3<sup>2</sup> + 3<sup>1</sup> − 3<sup>0</sup>, thus can be written as "++−", while 6 = 3<sup>2</sup> − 3<sup>1</sup> + 0 × 3<sup>0</sup>, i.e., "+−0".
[[wp:Balanced ternary|Balanced ternary]] is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary integer is in base 3, and each digit can have the values 1, 0, or 1. For example, decimal 11 = 3<sup>2</sup> + 3<sup>1</sup> 3<sup>0</sup>, thus can be written as "++", while 6 = 3<sup>2</sup> 3<sup>1</sup> + 0 × 3<sup>0</sup>, i.e., "+0".
For this task, implement balanced ternary representation of integers with the following
@ -11,6 +11,6 @@ For this task, implement balanced ternary representation of integers with the fo
'''Test case''' With balanced ternaries ''a'' from string "+-0++0+", ''b'' from native integer -436, ''c'' "+-++-":
* write out ''a'', ''b'' and ''c'' in decimal notation;
* calculate ''a'' × (''b'' − ''c''), write out the result in both ternary and decimal notations.
* calculate ''a'' × (''b'' ''c''), write out the result in both ternary and decimal notations.
'''Note:''' The pages [[generalised floating point addition]] and [[generalised floating point multiplication]] have code implementing [[wp:arbitrary precision|arbitrary precision]] [[wp:floating point|floating point]] balanced ternary.

View File

@ -114,7 +114,7 @@ normalise(N, L1, L) :-
% special case of number 0 !
strip_nombre([48]) --> {!}, "0".
% enlève les zéros inutiles
% enlève les zéros inutiles
strip_nombre([48 | L]) -->
strip_nombre(L).

View File

@ -1,6 +1,6 @@
/*REXX pgm converts decimal ◄───► balanced ternary; also performs arith.*/
/*REXX pgm converts decimal ◄───► balanced ternary; also performs arith.*/
numeric digits 10000 /*handle almost any size numbers.*/
Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by sub.*/
Ao = '+-0++0+' ; Abt = Ao /* [] 2 literals used by sub.*/
Bo = '-436' ; Bbt = d2bt(Bo) ; @ = '(decimal)'
Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
call btShow '[a]', Abt
@ -9,7 +9,7 @@ Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
say; $bt = btMul(Abt,btSub(Bbt,Cbt))
call btshow '[a*(b-c)]', $bt
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
d2bt: procedure; parse arg x 1; p=0; $.='-'; $.1='+'; $.0=0; #=
x=x/1
do until x==0; _=(x//(3**(p+1)))%3**p
@ -17,11 +17,11 @@ x=x/1
x=x-_*(3**p); p=p+1; #=$._ || #
end /*until*/
return #
/*──────────────────────────────────BT2D subroutine─────────────────────*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
bt2d: procedure; parse arg x; r=reverse(x); #=0; $.=-1; $.0=0; _='+'; $._=1
do j=1 for length(x); _=substr(r,j,1); #=#+$._*3**(j-1); end
return #
/*──────────────────────────────────BTADD subroutine────────────────────*/
/*──────────────────────────────────BTADD subroutine────────────────────*/
btAdd: procedure; parse arg x,y; rx=reverse(x); ry=reverse(y); carry=0
$.='-'; $.0=0; $.1='+'; @.=0; _='-'; @._=-1; _="+"; @._=1; #=
@ -35,7 +35,7 @@ $.='-'; $.0=0; $.1='+'; @.=0; _='-'; @._=-1; _="+"; @._=1; #=
#=$.s || #
end /*j*/
if carry\==0 then #=$.carry || #; return btNorm(#)
/*──────────────────────────────────BTMUL subroutine────────────────────*/
/*──────────────────────────────────BTMUL subroutine────────────────────*/
btMul: procedure; parse arg x,y; if x==0 | y==0 then return 0; S=1
x=btNorm(x); y=btNorm(y) /*handle: 0-xxx values.*/
if left(x,1)=='-' then do; x=btNeg(x); S=-S; end /*positate.*/
@ -48,7 +48,7 @@ P=0
end /*until*/
if S==-1 then P=btNeg(P) /*adjust product sign. */
return P /*return the product P.*/
/*───────────────────────────────one-line subroutines───────────────────*/
/*───────────────────────────────one-line subroutines───────────────────*/
btNeg: return translate(arg(1), '-+', "+-") /*negate the bal_tern #*/
btNorm: _=strip(arg(1),'L',0); if _=='' then _=0; return _ /*normalize*/
btSub: return btAdd(arg(1), btNeg(arg(2))) /*subtract two BT args.*/

View File

@ -12,7 +12,7 @@ w=w+5 /*add five spaces to widest word.*/
say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)
end /*n*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────BESTSHUFFLE subroutine──────────────*/
/*──────────────────────────────────BESTSHUFFLE subroutine──────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
if Lx<3 then return reverse(x) /*fast track these puppies. */
@ -22,7 +22,7 @@ if Lx<3 then return reverse(x) /*fast track these puppies. */
_=verify(x,a); if _==0 then iterate /*switch 1st rep with some char. */
y=substr(x,_,1); x=overlay(a,x,_)
x=overlay(y,x,j)
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/
y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd rep with later char.*/
x=overlay(a,x,_); x=overlay(y,x,j+1) /*OVERLAYs: a fast way to swap*/
end /*j*/
@ -34,7 +34,7 @@ if Lx<3 then return reverse(x) /*fast track these puppies. */
else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2)
end /*k*/
return x
/*──────────────────────────────────KSAME procedure─────────────────────*/
/*──────────────────────────────────KSAME procedure─────────────────────*/
kSame: procedure; parse arg x,y; k=0
do m=1 for min(length(x),length(y))
k=k + (substr(x,m,1) == substr(y,m,1))

View File

@ -24,7 +24,7 @@ if loc==-1 then do
say
say 'arithmetic mean of the' high "values=" avg
exit /*stick a fork in it, we're done.*/
/*─────────────────────────────────────BINARYSEARCH subroutine──────────*/
/*─────────────────────────────────────BINARYSEARCH subroutine──────────*/
binarySearch: procedure expose @ ?; parse arg low,high
if high<low then return -1
mid=(low+high)%2

View File

@ -27,5 +27,5 @@ tt=changestr('~~',other,";") /*change 2 tildes to a semicolon.*/
joined=dignsta || dingst2 /*join 2 strs together (concat). */
exit /*stick a fork in it, we're done.*/
/*─────────────────────────────────C2B subroutine───────────────────────*/
/*─────────────────────────────────C2B subroutine───────────────────────*/
c2b: return x2b(c2x(arg(1))) /*return the string as a binary string. */

View File

@ -5,9 +5,9 @@
/* Pigs and Bulls */
/* Bulls and Cleots */
/* MasterMind (or Master Mind) */
/*══════════════════════════════════════════════════════════════════════*/
/*══════════════════════════════════════════════════════════════════════*/
?=''; do until length(?)==4 /*generate unique 4-digit number.*/
r=random(1,9) /*change 1──►0 to allow a 0 dig*/
r=random(1,9) /*change 1──►0 to allow a 0 dig*/
if pos(r,?)\==0 then iterate /*don't allow a repeated digit. */
?=? || r
end /*until*/
@ -19,25 +19,25 @@ prompt='[Bulls & Cows game] ', /*build the prompt text string. */
say prompt; pull n; n=space(n,0); if n=='' then iterate
if abbrev('QUIT',n,1) then exit /*Does the user want to quit now?*/
g=?; L=length(n); bulls=0; cows=0
/*bull count─────────────────────*/
/*bull count─────────────────────*/
do j=1 for L; if substr(n,j,1)\==substr(g,j,1) then iterate
bulls=bulls+1 /*bump the bull count. */
g=overlay(' ',g,j) /*disallow this for a cow count. */
end /*j*/
/*cow count─────────────────────*/
/*cow count─────────────────────*/
do k=1 for L; x=substr(n,k,1); if pos(x,g)==0 then iterate
cows=cows+1 /*bump the cow count. */
g=translate(g,,x) /*this allows for rule variants. */
end /*k*/
if bulls\==4 then say "───── You got" bulls 'bull's(bulls) "and" cows 'cow's(cows)"."
if bulls\==4 then say "───── You got" bulls 'bull's(bulls) "and" cows 'cow's(cows)"."
end /*until bulls==4*/
say; say " ┌─────────────────────────────────────────┐"
say " │ │"
say " │ Congratulations, you've guessed it !! │"
say " │ │"
say " └─────────────────────────────────────────┘"; say
say; say " ┌─────────────────────────────────────────┐"
say " │ │"
say " │ Congratulations, you've guessed it !! │"
say " │ │"
say " └─────────────────────────────────────────┘"; say
exit
/*──────────────────────────────────S subroutine────────────────────────*/
/*──────────────────────────────────S subroutine────────────────────────*/
s: if arg(1)==1 then return ''; return 's'

View File

@ -1,3 +1,3 @@
Implement a [[wp:Caesar cipher|Caesar cipher]], both encryption and decryption. The key is an integer from 1 to 25. This cipher rotates the letters of the alphabet (A to Z). The encryption replaces each letter with the 1st to 25th next letter in the alphabet (wrapping Z to A). So key 2 encrypts "HI" to "JK", but key 20 encrypts "HI" to "BC". This simple "monoalphabetic substitution cipher" provides almost no security, because an attacker who has the encrypted message can either use frequency analysis to guess the key, or just try all 25 keys.
Caesar cipher is identical to [[Vigenère cipher]] with key of length 1. Also, [[Rot-13]] is identical to Caesar cipher with key 13.
Caesar cipher is identical to [[Vigenère cipher]] with key of length 1. Also, [[Rot-13]] is identical to Caesar cipher with key 13.

View File

@ -6,7 +6,7 @@ y=caesar(p, key) ; say ' cyphered:' y
z=caesar(y,-key) ; say ' uncyphered:' z
if z\==p then say "plain text doesn't match uncyphered cyphered text."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
caesar: procedure; parse arg s,k; @='abcdefghijklmnopqrstuvwxyz'
@=translate(@)@'0123456789(){}[]<>' /*add uppercase, digs, group symb*/
@=@'~!@#$%^&*_+:";?,./`-= ''' /*add other characters here. */
@ -19,5 +19,5 @@ if _\==0 then call err 'unsupported character:' substr(s,_,1)
if k>0 then ky=k+1
else ky=L+1-ak
return translate(s,substr(@||@,ky,L),@)
/*──────────────────────────────────ERR subroutine──────────────────────*/
/*──────────────────────────────────ERR subroutine──────────────────────*/
err: say; say '***error!***'; say; say arg(1); say; exit 13

View File

@ -8,7 +8,7 @@ y=caesar(p, key) ; say ' cyphered:' y
z=caesar(y,-key) ; say ' uncyphered:' z
if z\==p then say "plain text doesn't match uncyphered cyphered text."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
caesar: procedure; arg s,k; @='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; L=length(@)
ak=abs(k)
if ak > length(@)-1 | k==0 | k=='' then call err k 'key is invalid'
@ -18,5 +18,5 @@ if _\==0 then call err 'unsupported character:' substr(s,_,1)
if k>0 then ky=k+1 /*either cypher it, or ... */
else ky=27-ak /* decypher it. */
return translate(s,substr(@||@,ky,L),@)
/*──────────────────────────────────ERR subroutine──────────────────────*/
/*──────────────────────────────────ERR subroutine──────────────────────*/
err: say; say '***error!***'; say; say arg(1); say; exit 13

View File

@ -1,11 +1,11 @@
Create a routine that will generate a text calendar for any year. Test the calendar by generating a calendar for the year 1969, on a device of the time. Choose one of the following devices:
* A line printer with a width of 132 characters.
* An [[wp:IBM_3270#Displays|IBM 3278 model 4 terminal]] (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.
* An [[wp:IBM_3270#Displays|IBM 3278 model 4 terminal]] (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.
(Ideally, the program will generate well-formatted calendars for any page width from 20 characters up.)
Kudos (κῦδος) for routines that also correctly transition from Julian to Gregorian calendar in September 1752.
Kudos (κῦδος) for routines that also correctly transition from Julian to Gregorian calendar in September 1752.
This task is inspired by [http://www.ee.ryerson.ca/~elf/hack/realmen.html Real Programmers Don't Use PASCAL] by Ed Post, Datamation, volume 29 number 7, July 1983.
THE REAL PROGRAMMER'S NATURAL HABITAT

View File

@ -62,7 +62,7 @@ calfill=left(copies(calfill,cw),cw)
_yyyy=yyyy; calPuts=0; cv=1; _mm=mm+0; month=word(months,mm)
dy.2=28+ly(_yyyy); dim=dy._mm; _dd=01; dow=dow(_mm,_dd,_yyyy); $dd=dd+0
/*─────────────────────────────now: the business of the building the cal*/
/*─────────────────────────────now: the business of the building the cal*/
call calGen
do _j=2 to mc
if cv_\=='' then do
@ -80,10 +80,10 @@ call calGen
call fcalPuts
return _
/*─────────────────────────────calGen subroutine────────────────────────*/
/*─────────────────────────────calGen subroutine────────────────────────*/
calGen: cellX=;cellJ=;cellM=;calCells=0;calline=0
call calPut
call calPutl copies('─',calwidth),"┌┐"; call calHd
call calPutl copies('',calwidth),"┌┐"; call calHd
call calPutl month ' ' _yyyy ; call calHd
if narrowest | narrower then call calPutl daysn
else do jw=1 for 3
@ -97,23 +97,23 @@ calfb=1
if sd>32 & \shorter then call calPut
return
/*─────────────────────────────cellDraw subroutine──────────────────────*/
/*─────────────────────────────cellDraw subroutine──────────────────────*/
cellDraw: parse arg zz,cdDOY;zz=right(zz,2);calCells=calCells+1
if calCells>7 then do
calLine=calLine+1
cellX=substr(cellX,2)
cellJ=substr(cellJ,2)
cellM=substr(cellM,2)
cellB=translate(cellX,,")(─-"#)
cellB=translate(cellX,,")(-"#)
if calLine==1 then call cx
call calCsm; call calPutl cellX; call calCsj; call cx
cellX=; cellJ=; cellM=; calCells=1
end
cdDOY=right(cdDOY,cw); cellM=cellM'│'center('',cw)
cellX=cellX'│'centre(zz,cw); cellJ=cellJ'│'center('',cw)
cdDOY=right(cdDOY,cw); cellM=cellM''center('',cw)
cellX=cellX''centre(zz,cw); cellJ=cellJ''center('',cw)
return
/*═════════════════════════════general 1-line subs══════════════════════*/
/*═════════════════════════════general 1-line subs══════════════════════*/
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
@ -121,8 +121,8 @@ calCsj: if sd>49 & \shorter then call calPutl cellB; if sd>24 & \short then c
calCsm: if sd>24 & \short then call calPutl cellM; if sd>49 & \shorter then call calPutl cellB; return
calHd: if sd>24 & \shorter then call calPutl ; if sd>32 & \shortest then call calPutl ; return
calPb: calPuts=calPuts+1; maxKalPuts=max(maxKalPuts,calPuts); if symbol('CT.'calPuts)\=='VAR' then ct.calPuts=; ct.calPuts=overlay(arg(1),ct.calPuts,cv); return
calPutl: call calPut copies(' ',cindent)left(arg(2)"│",1)center(arg(1),calwidth)||right('│'arg(2),1);return
cx:cx_='├┤';cx=copies(copies('─',cw)'┼',7);if calft then do;cx=translate(cx,'┬',"┼");calft=0;end;if calfb then do;cx=translate(cx,'┴',"┼");cx_='└┘';calfb=0;end;call calPutl cx,cx_;return
calPutl: call calPut copies(' ',cindent)left(arg(2)"",1)center(arg(1),calwidth)||right(''arg(2),1);return
cx:cx_='';cx=copies(copies('',cw)'',7);if calft then do;cx=translate(cx,'',"");calft=0;end;if calfb then do;cx=translate(cx,'',"");cx_='';calfb=0;end;call calPutl cx,cx_;return
dow: procedure; arg m,d,y; if m<3 then do; m=m+12; y=y-1; end; yl=left(y,2); yr=right(y,2); w=(d+(m+1)*26%10+yr+yr%4+yl%4+5*yl)//7; if w==0 then w=7; return w
er :parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2;if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
@ -142,4 +142,4 @@ numx: return num(arg(1),arg(2),1)
p: return word(arg(1),1)
put: _=arg(1);_=translate(_,,'_'chk);if \grid then _=ungrid(_);if lowerCase then _=lower(_);if upperCase then upper _;if shortest&_=' ' then return;call tell _;return
tell: say arg(1);return
ungrid: return translate(arg(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
ungrid: return translate(arg(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")

View File

@ -5,15 +5,15 @@ The straightforward solution is a O(n<sup>2</sup>) algorithm (which we can call
'''bruteForceClosestPair''' of P(1), P(2), ... P(N)
'''if''' N &lt; 2 '''then'''
'''return''' ∞
'''return'''
'''else'''
minDistance ← |P(1) - P(2)|
minPoints ← { P(1), P(2) }
'''foreach''' i ∈ [1, N-1]
'''foreach''' j ∈ [i+1, N]
minDistance |P(1) - P(2)|
minPoints { P(1), P(2) }
'''foreach''' i [1, N-1]
'''foreach''' j [i+1, N]
'''if''' |P(i) - P(j)| < minDistance '''then'''
minDistance ← |P(i) - P(j)|
minPoints ← { P(i), P(j) }
minDistance |P(i) - P(j)|
minPoints { P(i), P(j) }
'''endif'''
'''endfor'''
'''endfor'''
@ -25,30 +25,30 @@ A better algorithm is based on the recursive divide&amp;conquer approach, as exp
'''closestPair''' of (xP, yP)
where xP is P(1) .. P(N) sorted by x coordinate, and
yP is P(1) .. P(N) sorted by y coordinate (ascending order)
'''if''' N ≤ 3 '''then'''
'''if''' N 3 '''then'''
'''return''' closest points of xP using brute-force algorithm
'''else'''
xL ← points of xP from 1 to ⌈N/2⌉
xR ← points of xP from ⌈N/2⌉+1 to N
xm ← xP(⌈N/2⌉)<sub>x</sub>
yL ← { p ∈ yP : p<sub>x</sub> ≤ xm }
yR ← { p ∈ yP : p<sub>x</sub> &gt; xm }
(dL, pairL) ← ''closestPair'' of (xL, yL)
(dR, pairR) ← ''closestPair'' of (xR, yR)
(dmin, pairMin) ← (dR, pairR)
xL ← points of xP from 1 to ⌈N/2⌉
xR ← points of xP from ⌈N/2⌉+1 to N
xm ← xP(⌈N/2⌉)<sub>x</sub>
yL ← { p ∈ yP : p<sub>x</sub> ≤ xm }
yR ← { p ∈ yP : p<sub>x</sub> &gt; xm }
(dL, pairL) ''closestPair'' of (xL, yL)
(dR, pairR) ''closestPair'' of (xR, yR)
(dmin, pairMin) (dR, pairR)
'''if''' dL &lt; dR '''then'''
(dmin, pairMin) ← (dL, pairL)
(dmin, pairMin) (dL, pairL)
'''endif'''
yS ← { p ∈ yP : |xm - p<sub>x</sub>| &lt; dmin }
nS ← number of points in yS
(closest, closestPair) ← (dmin, pairMin)
yS ← { p ∈ yP : |xm - p<sub>x</sub>| &lt; dmin }
nS number of points in yS
(closest, closestPair) (dmin, pairMin)
'''for''' i '''from''' 1 '''to''' nS - 1
k ← i + 1
'''while''' k ≤ nS '''and''' yS(k)<sub>y</sub> - yS(i)<sub>y</sub> &lt; dmin
k i + 1
'''while''' k nS '''and''' yS(k)<sub>y</sub> - yS(i)<sub>y</sub> &lt; dmin
'''if''' |yS(k) - yS(i)| &lt; closest '''then'''
(closest, closestPair) ← (|yS(k) - yS(i)|, {yS(k), yS(i)})
(closest, closestPair) (|yS(k) - yS(i)|, {yS(k), yS(i)})
'''endif'''
k ← k + 1
k k + 1
'''endwhile'''
'''endfor'''
'''return''' closest, closestPair

View File

@ -23,12 +23,12 @@ minDD=(@.nearA.xx-@.nearB.xx)**2 + (@.nearA.yy-@.nearB.yy)**2
end /*j*/
say 'For' N "points:"; say
say ' 'center('x',w,"═")' ' center('y',w,"═")
say ' 'center('x',w,"")' ' center('y',w,"")
say 'The points ['right(@.nearA.xx,w)"," right(@.nearA.yy,w)"]" ' and'
say ' ['right(@.nearB.xx,w)"," right(@.nearB.yy,w)"]"; say
say 'the minimum distance between them is: ' sqrt(abs(minDD))
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────sqrt subroutine────────────────────*/
/*───────────────────────────────────sqrt subroutine────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0;d=digits();numeric digits 11
g=.sqrtG(); do j=0 while p>9; m.j=p; p=p%2+1; end
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end

View File

@ -31,6 +31,6 @@ fib.5 = 5
fib.6 = 8
fib.7 =17
do n=-5 to 5 /*define an array from -5 ──► 5 */
do n=-5 to 5 /*define an array from -5 ──► 5 */
sawtooth.n=n
end /*n*/ /*eleven elements will be defined. */

View File

@ -14,20 +14,20 @@ There can be no intervening character between the slash and asterisk (or
the asterisk and slash). These two joined characters cannot be separated
via a continued line, as in the manner of:
say 'If I were two─faced,' ,
say 'If I were twofaced,' ,
'would I be wearing this one?' ,
' --- Abraham Lincoln'
Here come's the thingy that ends this REXX comment. ───┐
│
│
↓
Here come's the thingy that ends this REXX comment.
*/
hour = 12 /*high noon */
midnight = 00 /*first hour of the day */
suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */
suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */
hutchHdr = '/*'
hutchEnd = "*/"
@ -35,7 +35,7 @@ hutchEnd = "*/"
/* the previous two "hutch" assignments aren't
the start nor the end of a REXX comment. */
x=1000000 ** /*¡big power!*/ 1000
x=1000000 ** /*¡big power!*/ 1000
/*not a real good place for a comment (above),
but essentially, a REXX comment can be

View File

@ -4,12 +4,12 @@ numeric digits 20 /*use a fair amount of precision.*/
lightSource = norm('-50 30 50')
call drawSphereM 2, .5, lightSource
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────drawSphereM subroutine──────────────*/
/*──────────────────────────────────drawSphereM subroutine──────────────*/
drawSphereM: procedure; parse arg k,ambient,lightSource
z1=0; z2=0
parse var lightSource s1 s2 s3 /*break-apart the light source. */
shading='·:!ºoe@░▒▓' /*shading chars for ASCI machines*/
shading='·:!ºoe@' /*shading chars for ASCI machines*/
if 1=='f1'x then shading='.:!*oe&#%@' /*shading chars for EBCDIC machs.*/
shadesLength=length(shading)
@ -52,7 +52,7 @@ hole=' 1 1 -6 20'; parse var hole hole.cx hole.cy hole.cz hole.radius
end /*i*/
return
/*──────────────────────────────────hitSphere subroutine────────────────*/
/*──────────────────────────────────hitSphere subroutine────────────────*/
hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
x=x0-$.cx
y=y0-$.cy
@ -61,7 +61,7 @@ hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
z1=$.cz-_
z2=$.cz+_
return 1
/*──────────────────────────────────"1-liner" subroutines───────────────*/
/*──────────────────────────────────"1-liner" subroutines───────────────*/
V3: procedure; parse arg v; return norm(v)
dot.: procedure; parse arg x,y; d=dot(x,y); if d<0 then return -d; return 0
dot: procedure; parse arg x,y; s=0; do j=1 for words(x); s=s+word(x,j)*word(y,j); end; return s

View File

@ -6,9 +6,9 @@ y = x-x /*setting to zero the obtuse way.*/
z = x/y /*this'll do it, furrrr shurrre. */
exit /*We're kaput. Ja vohl ! */
/*───────────────────────────────error handling subroutines and others.─*/
/*───────────────────────────────error handling subroutines and others.─*/
err: if rc==42 then do; say; say /*1st, check for a specific error*/
say center(' division by zero is a no-no. ',79,'═')
say center(' division by zero is a no-no. ',79,'')
say; say
exit 130
end

View File

@ -1,5 +1,5 @@
#lang racket
(with-handlers ([exn:fail:contract:divide-by-zero?
(λ (e) (displayln "Divided by zero"))])
(λ (e) (displayln "Divided by zero"))])
(/ 1 0))

View File

@ -33,14 +33,14 @@ zzz=' - 000008.201e-00000000000000002 '
if \datatype(yyy,'n') then say 'oops, not numeric:' yyy
if \datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'numeric') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'nimrod.') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'numeric') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'nimrod.') then say 'oops, not numeric:' yyy
if datatype(yyy)\=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)/=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬= 'NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬= 'NUM' then say 'oops, not numeric:' yyy
/*note: REXX only looks at the first char for DATATYPE's 2nd arg. */
/*note: some REXX interpreters don't support the ¬ (not) character.*/
/*note: some REXX interpreters don't support the ¬ (not) character.*/

View File

@ -17,11 +17,11 @@ sum=0 /*calc info entropy for each char*/
say ' input string: ' $
say 'string length: ' L
say ' unique chars: ' n ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
say 'the information entropy of the string ' format(sum,,12) " bits."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────LOG2 subroutine─────────────────────*/
/*──────────────────────────────────LOG2 subroutine─────────────────────*/
log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
numeric digits digits()+5 /* [] precision of E must be > digits().*/
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
do while ig & xx>1.5 | \ig&xx<.5; _=e; do k=-1; iz=xx* _**-is
if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end

View File

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do n=1 for 100
select

View File

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do n=1 for 100; _=
if n//3 ==0 then _= 'Fizz'

View File

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do j=1 to 100; z=j
if j//3 ==0 then z='Fizz'

View File

@ -1,9 +1,9 @@
/*REXX program shuffles a deck of playing cards using the Knuth shuffle.*/
rank='ace duece trey 4 5 6 7 8 9 10 jack queen king'
suit='club spade diamond heart'
say '────────────────── getting a new deck out of the box...'
say ' getting a new deck out of the box...'
deck.1=' color joker' /*good decks have a color joker, */
deck.2=' b&w joker' /*∙∙∙ and a black & white joker. */
deck.2=' b&w joker' /*∙∙∙ and a black & white joker. */
cards=2 /*now, two cards are in the deck.*/
do j =1 for words(suit)
do k=1 for words(rank)
@ -13,7 +13,7 @@ cards=2 /*now, two cards are in the deck.*/
end /*j*/
call showDeck 'ace' /*inserts blank when ACE is found*/
say '────────────────── shuffling' cards "cards..."
say ' shuffling' cards "cards..."
do s=cards by -1 to 1; rand=random(1,s)
if rand\==s then do /*swap two cards in the card deck*/
@ -24,14 +24,14 @@ say '────────────â
end /*s*/
call showDeck
say '────────────────── ready to play schafkopf (take out jokers first).'
say ' ready to play schafkopf (take out jokers first).'
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SHOWDECK subroutine─────────────────*/
/*──────────────────────────────────SHOWDECK subroutine─────────────────*/
showDeck: parse arg break; say
do m=1 for cards
if pos(break,deck.m)\==0 then say /*blank, easier to read cards*/
say 'card' right(m,2) '───►' deck.m
say 'card' right(m,2) '' deck.m
end /*m*/
say
return

View File

@ -3,7 +3,7 @@ ifid = 'UNIXDICT.TXT' /*filename of the word dictionary*/
@.= /*placeholder for list of words. */
mL=0 /*maximum length of ordered words*/
call linein ifid,1,0 /*point to the first word in dict*/
/*(above)───in case file is open.*/
/*(above)───in case file is open.*/
do j=1 while lines(ifid)\==0 /*keep reading until exhausted. */
x=linein(ifid); w=length(x) /*get a word and also its length.*/
if w<mL then iterate /*if not long enough, ignore it. */
@ -14,7 +14,7 @@ call linein ifid,1,0 /*point to the first word in dict*/
if \datatype(_,'U') then iterate /*Not a letter? Then skip it. */
if _<z then iterate j /*is letter < than the previous ?*/
z=_ /*we have a newer current letter.*/
end /*k*/ /*(above) logic includes ≥ order.*/
end /*k*/ /*(above) logic includes order.*/
mL=w /*maybe define a new maximum len.*/
@.w=@.w x /*add orig. word to a word list.*/
@ -24,5 +24,5 @@ q=words(@.mL) /*just a handy-dandy var to have.*/
say q 'word's(q) "found (of length" mL')'; say /*show #words & length*/
do n=1 for q; say word(@.mL,n); end /*list all the words. */
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────S subroutine────────────────────────*/
/*──────────────────────────────────S subroutine────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*a simple pluralizer.*/

View File

@ -6,7 +6,7 @@ numeric digits digs /*big digs, the slower the spits.*/
pi=0; s=16; r=4; v=5; vs=v*v; g=239; gs=g*g; old=; spewed=0; j=1
call time 'E'
/*─────────────────────────────────────John Machin's formula for pi. */
/*─────────────────────────────────────John Machin's formula for pi. */
do n=1 by 2
pi=pi + s/(n*v) - r/(n*g)
if pi==old then leave /*no further with current DIGITS.*/

View File

@ -34,7 +34,7 @@ if found then return j /*return haystack index number. */
else say needle "wasn't found in the haystack!"
return 0 /*indicates needle wasn't found. */
/*─────────────────────────────────────────────── incidentally, to find */
/*─────────────────────────────────────────────── incidentally, to find */
/* the number of haystack items: */
hayItems=0