Floating-point Fractions

Recently, I wanted a way to convert floating-point numbers into fractions using Factor. To do this (with any hope of being correct), I spent some time understanding how floating-point numbers are represented.

Two useful resources about floating-point numbers are an article entitled "What Every Computer Scientist Should Know About Floating-Point Arithmetic" and a website called The Floating-Point Guide.

Basic floating-point numbers are specified using a sign bit, an exponent, and a mantissa. Aside from some special numbers (e.g., +Inf, -Inf, NaN) and denormal numbers, the value of a floating-point can be calculated using the formula:

(-1)^sign × 2^{exponent - exponent bias} × 1.mantissa

We will be working with double precision floating point values (e.g., 64-bit values):

To extract the sign, exponent, and mantissa bits is fairly easy:

USING: kernel math math.bitwise math.functions ;

: sign ( bits -- sign )
    -63 shift ;

: exponent ( bits -- exponent )
    -52 shift 11 on-bits mask ;

: mantissa ( bits -- mantissa )
    52 on-bits mask ;

We are not going to support special values, so we throw an error if we encounter one:

: check-special ( n -- n )
    dup fp-special? [ "cannot be special" throw ] when ;

Converting to a ratio (e.g., numerator and denominator) is just a matter of computing the formula (with some special handling for denormal numbers where the exponent is zero):

: float>ratio ( n -- a/b )
    check-special double>bits
    [ sign zero? 1 -1 ? ] [ mantissa 52 2^ / ] [ exponent ] tri
    dup zero? [ 1 + ] [ [ 1 + ] dip ] if 1023 - 2 swap ^ * * ;

You can see this in action:

( scratchpad ) 0.5 float>ratio .
1/2

( scratchpad ) 12.5 float>ratio .
12+1/2

( scratchpad ) 0.333333333333333 float>ratio .
6004799503160655/18014398509481984

( scratchpad ) USE: math.constants
( scratchpad ) pi float>ratio .
3+39854788871587/281474976710656

Hello, web!

One thing that surprises many people when they come to Factor, is that a lot of the Factor infrastructure (main site, planet, pastebin, documentation, and wiki) is written in Factor, and runs on a Factor web server.

The Factor web server is very capable, supporting static files, CGI scripts, SSL authentication, session management, and dynamic web pages. Some of the vocabularies that are involved:

• http.server, the web server
• furnace, the web framework
• db, the database support
• html.templates (both chloe and fhtml)
• html.forms and form validators

Hello, world!

This is a simple application that returns a plain text page that says "Hello, world!". Our web application is structured into a dispatcher (our "main responder"), an action, and words to create and run the web server.

USING: accessors furnace.actions http.server
http.server.dispatchers http.server.responses io.servers kernel
namespaces ;

IN: webapps.hello

TUPLE: hello < dispatcher ;

: <hello-action> ( -- action )
    <page-action>
        [ "Hello, world!" "text/plain" <content> ] >>display ;

: <hello> ( -- dispatcher )
    hello new-dispatcher
        <hello-action> "" add-responder ;

: run-hello ( -- )
    <hello>
        main-responder set-global
    8080 httpd wait-for-server ;

MAIN: run-hello

Run the code by calling run-hello, then navigate to http://localhost:8080 and you will see the response.

Templates

To begin experimenting with templates, lets change the logic to include a form where a name can be provided. We will create a Chloe template file. Let's create a hello.xml file in the same location as the webapps.hello vocabulary:

<?xml version='1.0' ?>

<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">

    <t:form t:action="$hello">
        <label>What is your name?</label>
        <t:field t:name="name" />
        <input type="submit" />
    </t:form>

</t:chloe>

Now, modify the hello-action to load the template. The default form submission is via POST and can be supported using the submit slot of the action. We respond to a form submission by returning a plain text response saying "Hello, $name!":

USE: formatting

: <hello-action> ( -- action )
    <page-action>
        { hello "hello" } >>template
        [
            "name" param "Hello, %s!" sprintf
            "text/plain" <content>
        ] >>submit ;

When you navigate to http://localhost:8080, you will see a simple form prompting you to type in a name. After submitting the form, you will see a customized response depending on the name provided.

Form Validation

It is frequently useful to validate parameters that are submitted via forms (e.g., for numbers, e-mail addresses, ranges, required or optional, etc.). To support this, we need to add validation logic for every parameter desired (using words from the validators vocabulary). In this case, the name should be a required parameter:

USE: validators

: <hello-action> ( -- action )
    <page-action>
        [
            { { "name" [ v-required ] } } validate-params
        ] >>validate
        { hello "hello" } >>template
        [
            "name" value "Hello, %s!" sprintf
            "text/plain" <content>
        ] >>submit ;

Next, wrap the dispatcher in an <alloy>, which provides support for session-persistence, form validation, and database persistence.

USE: furnace.alloy
USE: db.sqlite

: <hello> ( -- dispatcher )
    hello new-dispatcher
        <hello-action> "" add-responder
     "resource:hello.db" <sqlite-db> <alloy> ;

If you navigate to the website now, and don't provide a name, you'll be redirected back to the form with the validation error specified.

Other tips

There is a development? symbol that can be set to t to make sure the web server is running the latest code from your application and that errors generate nice stack traces.

Malu has a nice tutorial on Github about building a blog application in Factor.

All of the Factor websites (as well as some nice examples like a "counter", "todo list", "tiny url", and "ip address") are in resource:extra/webapps.

Calculator with GUI

Update: Kyle Cordes has made some nice refactoring to avoid the "code smell" of passing global variables around while building the gadgets.

I started playing around with the Factor GUI framework recently. The documentation is very detailed, but sometimes it is nice to have simple examples to learn from.

I thought it would be fun to build a simple calculator application. A teaser of what it will look like when we are done:

First, some imports and a namespace.

USING: accessors colors.constants combinators.smart kernel fry
math math.parser models namespaces sequences ui ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.tracks ui.pens.solid ;

FROM: models => change-model ;

IN: calc-ui

Note: we have to specifically import change-model from the models vocabulary, since it might conflict with an accessor.

Factor user interface elements are called gadgets. Many of them support being dynamically updated by being connected to models. Each model maintains a list of connections that should be updated when the value being held by the model changes.

The Model

Our calculator model is based on the notion that we have two numbers (x and y) and an operator that can be applied to produce a new value.

TUPLE: calculator < model x y op valid ;

: <calculator> ( -- model )
    "0" calculator new-model 0 >>x ;

If we want to reset the model (such as when we press the "clear" button):

: reset ( model -- )
    0 >>x f >>y f >>op f >>valid "0" swap set-model ;

We're storing all values as floating-point numbers, but (for display purposes) we'll show integers when possible:

: display ( n -- str )
    >float number>string dup ".0" tail? [
        dup length 2 - head
    ] when ;

Each of x and y can be set based on the value, and the op is specified as a quotation:

: set-x ( model -- model )
    dup value>> string>number >>x ;

: set-y ( model -- model )
    dup value>> string>number >>y ;

: set-op ( model quot: ( x y -- z ) -- )
    >>op set-x f >>y f >>valid drop ;

Pushing the "=" button triggers the calculation:

: (solve) ( model -- )
    dup [ x>> ] [ y>> ] [ op>> ] tri call( x y -- z )
    [ >>x ] keep display swap set-model ;

: solve ( model -- )
    dup op>> [ dup y>> [ set-y ] unless (solve) ] [ drop ] if ;

We support negating the number:

: negate ( model -- )
    dup valid>> [
        dup value>> "-" head?
        [ [ 1 tail ] change-model ]
        [ [ "-" prepend ] change-model ] if
    ] [ drop ] if ;

And pushing the "." button (to add a decimal), or a number (to add a digit):

: decimal ( model -- )
    dup valid>>
    [ [ dup "." subseq? [ "." append ] unless ] change-model ]
    [ t >>valid "0." swap set-model ] if ;

: digit ( n model -- )
    dup valid>>
    [ swap [ append ] curry change-model ]
    [ t >>valid set-model ] if ;

That pretty much rounds out the basic features of the model.

The GUI

For convenience, I store the calculator model in a global symbol:

SYMBOL: calc
<calculator> calc set-global

I can use that to create buttons for each type (using short names and unicode characters to make the code a bit prettier):

: [C] ( -- button )
    "C" calc get-global '[ drop _ reset ] <border-button> ;

: [±] ( -- button )
    "±" calc get-global '[ drop _ negate ] <border-button> ;

: [+] ( -- button )
    "+" calc get-global '[ drop _ [ + ] set-op ] <border-button> ;

: [-] ( -- button )
    "-" calc get-global '[ drop _ [ - ] set-op ] <border-button> ;

: [×] ( -- button )
    "×" calc get-global '[ drop _ [ * ] set-op ] <border-button> ;

: [÷] ( -- button )
    "÷" calc get-global '[ drop _ [ / ] set-op ] <border-button> ;

: [=] ( -- button )
    "=" calc get-global '[ drop _ solve ] <border-button> ;

: [.] ( -- button )
    "." calc get-global '[ drop _ decimal ] <border-button> ;

: [#] ( n -- button )
    dup calc get-global '[ drop _ _ digit ] <border-button> ;

: [_] ( -- label )
    "" <label> ;

We will create a label that is updated when the model changes.

: <display> ( -- label )
    calc get-global <label-control> { 5 5 } <border>
        { 1 1/2 } >>align
        COLOR: gray <solid> >>boundary ;

And, finally, creating the GUI (using vertical and horizontal track layouts):

: <col> ( quot -- track )
    vertical <track> 1 >>fill { 5 5 } >>gap
    swap output>array [ 1 track-add ] each ; inline

: <row> ( quot -- track )
    horizontal <track> 1 >>fill { 5 5 } >>gap
    swap output>array [ 1 track-add ] each ; inline

: calc-ui ( -- )
    [
        <display>
        [     [C]     [±]     [÷]    [×] ] <row>
        [ "7" [#] "8" [#] "9" [#]    [-] ] <row>
        [ "4" [#] "5" [#] "6" [#]    [+] ] <row>
        [ "1" [#] "2" [#] "3" [#]    [=] ] <row>
        [ "0" [#]     [.]     [_]    [_] ] <row>
    ] <col> { 10 10 } <border> "Calculator" open-window ;

MAIN: calc-ui

Then, running the calculator application:

( scratchpad ) "calc-ui" run

The code for this is on my Github.

Building "cat"

One neat feature of Factor is the ability to create and deploy programs as compiled binaries -- both CLI (command-line) or UI (graphical) applications.

I thought it might be fun to build the cat command-line program in Factor, and show how it can be deployed as a binary. From the man pages:

The cat utility reads files sequentially, writing them to the standard output. The file operands are processed in command-line order. If file is a single dash ('-') or absent, cat reads from the standard input.

We'll start by creating the cat vocabulary. You can either create the cat.factor file yourself, or use tools.scaffold to do it for you:

( scratchpad ) USE: tools.scaffold

( scratchpad ) "cat" scaffold-work
Creating scaffolding for P" resource:work/cat/cat.factor"

( scratchpad ) "cat" vocab edit

Begin the implementation by listing some imports and a namespace:

USING: command-line kernel io io.encodings.binary io.files
namespaces sequences strings ;

IN: cat

Printing each line from a stream is easy using the each-line word (flushing after each write to match the behavior of cat):

: cat-lines ( -- )
    [ write nl flush ] each-line ;

I chose to treat files (which might be text or binary) as binary, reading and writing 1024 bytes at a time. We check that the file exists, printing an error if not found:

: cat-stream ( -- )
    [ 1024 read dup ] [ >string write flush ] while drop ;

: cat-file ( path -- )
    dup exists?
    [ binary [ cat-stream ] with-file-reader ]
    [ write ": not found" write nl flush ] if ;

Given a list of files, with a special case for "-" (to read from standard input), we can cat each one:

: cat-files ( paths -- )
    [ dup "-" = [ drop cat-lines ] [ cat-file ] if ] each ;

Finally, we need an entry point that checks if command-line arguments have been provided:

: run-cat ( -- )
    command-line get [ cat-lines ] [ cat-files ] if-empty ;

MAIN: run-cat

Using the deploy-tool:

( scratchpad ) "cat" deploy-tool

Click "Save" to persist the deploy settings into a deploy.factor file, and "Deploy" to create a binary. You should see output like the following:

Deploying cat...
Writing vocabulary manifest
Preparing deployed libraries
Stripping manual memory management debug code
Stripping destructor debug code
Stripping stack effect checking from call( and execute(
Stripping specialized arrays
Stripping startup hooks
Stripping default methods
Stripping compiler classes
Finding megamorphic caches
Stripping globals
Compressing objects
Compressing quotations
Stripping word properties
Stripping symbolic word definitions
Stripping word names
Clearing megamorphic caches
Saving final image

And your binary should be in the same directory as your Factor installation (in a cat.app sub-directory on the Mac).

$ ls -hl cat.app/Contents/MacOS/cat 
-rwxr-xr-x  1 user  staff  421k Aug 21 11:11 cat.app/Contents/MacOS/cat*

$ cat.app/Contents/MacOS/cat
hello, world
hello, world
^D

The code for this is on my Github.

Marriage Sort

Several months ago, someone introduced a sorting algorithm called "Marriage Sort". The inspiration for it came from an article analyzing how to (mathematically) select the best wife/husband.

The "conclusion" drawn from the article is that, given N candidates, the strategy with the best expected value is to skip past the first sqrt(N) - 1 candidates and then choose the next "best so far".

Translated loosely into a sorting algorithm, it goes something like this:

1. Given N candidates, calculate the number to skip.
2. Find the "best" candidate within the skip distance.
3. Move all the better candidates beyond the skip distance to the end.
4. Reduce N by the number of candidates moved.
5. Repeat from Step 1 until we run out of candidates.
6. Perform insertion sort.

The marriage sort algorithm is not particularly fast, with a runtime of O(n^1.5), but sorting algorithms are fundamental to computing, so I thought it would be fun to implement in Factor.

Note: Factor comes with some sorting algorithms. The sorting vocabulary implements merge sort and the sorting.insertion vocabulary implements an in-place insertion sort.

First, some vocabularies and a namespace (we will be using locals to implement a couple of the words):

USING: kernel locals math math.functions sequences
sorting.insertion ;

IN: sorting.marriage

We can take the loose algorithm and structure the marriage-sort word, leaving the bulk of the work for the (marriage-sort) inner loop:

: marriage-sort ( seq -- )
    dup length
    [ dup sqrt 1 - >fixnum dup 0 > ]
    [ (marriage-sort) ] while 2drop
    [ ] insertion-sort ;

We'll need to find the index of the maximum element in a range:

:: find-max ( from to seq -- i )
    from to >= [ f ] [
        from from 1 + [ dup to < ] [
            2dup [ seq nth ] bi@ < [ nip dup ] when 1 +
        ] while drop
    ] if ;

That leaves the (marriage-sort) word (probably more complex than necessary, but it works):

:: (marriage-sort) ( seq end skip -- seq end' )
    0 skip seq find-max
    skip end [ 2dup < ] [
        2over [ seq nth ] bi@ <=
        [ 1 - [ seq exchange ] 2keep ]
        [ [ 1 + ] dip ] if
    ] while nip 1 - [ seq exchange seq ] keep ;

Some performance numbers (given a 10,000 element random array):

( scratchpad ) 10000 [ random-32 ] replicate

( scratchpad ) dup clone [ natural-sort drop ] time
Running time: 0.004123694 seconds

( scratchpad ) dup clone [ marriage-sort ] time
Running time: 0.063077446 seconds

( scratchpad ) dup clone [ [ ] insertion-sort ] time
Running time: 10.972027614 seconds

As you can see, slower than natural-sort (which uses merge sort), but much faster than insertion-sort, with similar in-place semantics. It's worth noting that the code for insertion-sort seems a little slow and could probably be sped up quite a bit.

The code and some tests for this is on my Github.

"Maybe" Accessor

Factor has support for standard "object-oriented" programming concepts such as classes and attributes. Recently, I wanted to "get an attributes value (setting it first if not set)". I came up with a technique to do this, and wanted to share.

First, some background. Defining a class "person" with attributes "name" and "age":

TUPLE: person name age ;

You can then create a new instance with all attributes unset (e.g., set to f):

( scratchpad ) person new .
T{ person }

Or, you can create an instance by order of arguments (taking values from the stack):

( scratchpad ) "Frank" 20 person boa .
T{ person { name "Frank" } { age 20 } }

Alternatively, you can use the accessors vocabulary to set attributes on the instance:

( scratchpad ) person new 
( scratchpad ) "Frank" >>name 20 >>age .
T{ person { name "Frank" } { age 20 } }

Reading attributes from an instance:

( scratchpad ) "Frank" 20 person boa
( scratchpad ) name>>
"Frank"

Sometimes it is useful to change attributes:

( scratchpad ) "Frank" 20 person boa 
( scratchpad ) [ 1 + ] change-age .
T{ person { name "Frank" } { age 21 } }

If you want to change an attribute only if it was not already set, we could use change-name. The definition of change-name is built using "get" and "set" words (first get the current value, then call the quotation and set the result as the new value).

( scratchpad ) person new 
( scratchpad ) [ "Frank" or ] change-name .
T{ person { name "Frank" } }

Coming back to the original problem: how can I "set an attribute if not set and then immediately get the attribute"? Using the "get, set, or change" concepts, we could first change the name, then get the current value:

( scratchpad ) person new 
( scratchpad ) [ "Frank" or ] change-name
( scratchpad ) name>> .
"Frank"

One problem with that is it performs two get's and a set (and potentially does work in the quotation that is not necessary if a value already exists). It would be more efficient if we could do something like:

( scratchpad ) person new 
( scratchpad ) dup name>> [ nip ] [ "Frank" [ >>name drop ] keep ] if* .
"Frank"

But that code is pretty verbose, and obscures our intentions. It would be better if we could define a maybe-name word that performs this action:

: maybe-name ( object quot: ( -- x ) -- value )
    [ [ >>name drop ] keep ] compose
    [ dup name>> [ nip ] ] dip if* ; inline

Perhaps a better name for this word could be ?name>> or |name>>, both of which I like also.

This works like so:

( scratchpad ) person new
( scratchpad ) [ "Joe" ] maybe-name .
"Joe"

( scratchpad ) "Frank" 30 person boa 
( scratchpad ) [ "Joe" ] maybe-name .
"Frank"

It would be even better if we could define these words automatically for every attribute in the class (the way the accessors vocab does). Well, this isn't too difficult (although the code that builds the word programmatically is a little involved). We can take advantage of the very dynamic nature of Factor:

USING: accessors arrays kernel make quotations sequences
slots words ;

IN: accessors.maybe

: maybe-word ( name -- word )
    "maybe-" prepend "accessors" create ;

: define-maybe ( name -- )
    dup maybe-word dup deferred? [
        [
            over setter-word \ drop 2array >quotation
            [ keep ] curry , \ compose ,
            swap reader-word [ dup ] swap 1quotation compose
            [ [ nip ] ] compose , \ dip , \ if* ,
        ] [ ] make (( object quot: ( -- x ) -- value )) define-inline
    ] [ 2drop ] if ;

: define-maybe-accessors ( class -- )
    "slots" word-prop [
        dup read-only>> [ drop ] [ name>> define-maybe ] if
    ] each ;

Calling it will define a "maybe" accessor word for each slot in the tuple:

( scratchpad ) << person define-maybe-accessors >>

This code and some tests is available on my Github.

Anagrams

Dave Thomas, one of the Pragmatic Programmers, has developed a series of exercises on his site codekata.com. The idea behind it is based on the concept that to get good at something you should "practice, practice, practice". Malcolm Gladwell calls this the 10,000 Hour Rule in his book Outliers.

While browsing the site, I came across Kata Six: Anagrams. Below is my attempt in Factor.

If you want to avoid spoilers and attempt this yourself, you might not want to read the rest of this post.

First, some preliminary imports and a namespace:

USING: arrays ascii assocs fry io.encodings.ascii io.files
kernel math memoize sequences sorting strings ;

IN: anagrams

One way to check if two words are anagrams is to sort their letters and compare. For example, "listen" and "silent" are anagrams of each other (i.e., when sorted, their letters are both "eilnst").

We will use this approach to take a list of words and create a mapping of their sorted letters to a list of words that are anagrams of each other. After we do that, we'll filter the map to only have words that have anagrams (where two or more words share the same mapping).

: (all-anagrams) ( seq assoc -- )
    '[ dup natural-sort >string _ push-at ] each ;

: all-anagrams ( seq -- assoc )
    H{ } clone [ (all-anagrams) ] keep
    [ nip length 1 > ] assoc-filter ;

You can see it in action:

( scratchpad ) { "listen" "silent" "orange" } all-anagrams .
H{ { "eilnst" V{ "listen" "silent" } } }

Now that we have that, we need a word list. The link on the original blog post no longer works, but most systems come with a dictionary, so we will use that (making all the words lowercase so that we can compare in a case-insensitive way).

MEMO: dict-words ( -- seq )
    "/usr/share/dict/words" ascii file-lines [ >lower ] map ;

Given a list of dictionary words, we can calculate all anagrams:

MEMO: dict-anagrams ( -- assoc )
    dict-words all-anagrams ;

On my MacBook Pro, I see 234,936 words and 15,048 groups of anagrams. Using these, we can write a word to look for anagrams by checking the dictionary.

: anagrams ( str -- seq/f )
    >lower natural-sort >string dict-anagrams at ;

I chose to return f if no anagrams are found. You can try it out:

( scratchpad ) "listen" anagrams .
V{ "enlist" "listen" "silent" "tinsel" }

( scratchpad ) "banana" anagrams .
f

The blog goes further and asks a couple questions:

• What sets of anagrams contain the most words?
  
• What are the longest words that are anagrams?
  

Both of these share a common process, which is to take a sequence and filter it for the elements that have the longest length:

: longest ( seq -- subseq )
    dup 0 [ length max ] reduce '[ length _ = ] filter ;

This works pretty simply:

( scratchpad ) { "a" "ab" "abc" "abcd" "hjkl" } longest .
{ "abcd" "hjkl" }

Now we can write the words to answer those two questions:

: most-anagrams ( -- seq )
    dict-anagrams values longest ;

: longest-anagrams ( -- seq )
    dict-anagrams [ keys longest ] keep '[ _ at ] map ;

The answer is? The set of anagrams containing "groan" is the most (10 words). And two anagrams are tied for longest: "pneumohydropericardium/hydropneumopericardium" and "cholecystoduodenostomy/duodenocholecystostomy". Wouldn't you know, they'd be medical words...

The code for this is available on my Github.

Fat Arrows

Update: I found out that the extra/pair-rocket vocabulary implements this functionality, apparently named after Ruby's hash-rockets.

Today, I saw a blog post about adding "fat arrows" (syntactic sugar to support dictionaries) to the efene programming language.

One of Factor's strengths is defining new syntax to make certain problems more possible or more elegant. In this post, I will show what it takes to add "fat arrows" to Factor.

First, what is a "fat arrow"? It appears to be simple syntax to create two-element arrays, but without using "array syntax". Assuming we had already defined it, it would work something like this:

( scratchpad ) 1 => 2 .
{ 1 2 }

( scratchpad ) t => "some text" .
{ t "some text" }

So, how do we implement it? The documentation is pretty detailed and includes an article about the parser and, in particular, parsing words.

The basic strategy is:

1. get the last object parsed
2. parse ahead to read the next object
3. wrap both elements into an array
4. place the array back onto the parse sequence

The core to this is reading ahead to parse the next object. This can be accomplished with the scan-object word. Once we know that, it's pretty straightforward to implement:

SYNTAX: =>
    unclip-last scan-object 2array suffix! ;

I'm not a huge fan of this syntax (since it is very close to <=>, one of the comparative words), but it does make case statements look prettier. Here's one from the examples:

SYMBOL: yes  SYMBOL: no  SYMBOL: maybe
maybe {
    yes   => [ ] ! Do nothing
    no    => [ "No way!" throw ]
    maybe => [ "Make up your mind!" print ]
    [ "Invalid input; try again." print ]
} case ;

Happy Numbers

Another recent challenge was to implement a method to check for happy numbers.

"Starting with any positive integer, replace the number by the sum of the squares of its digits, and repeat the process until the number equals 1 (where it will stay), or it loops endlessly in a cycle which does not include 1. Those numbers for which this process ends in 1 are happy numbers, while those that do not end in 1 are unhappy numbers (or sad numbers)."

Many of the solutions listed are short, and this might qualify as a nice question to use when interviewing programmers. Here is one solution in Python from Wikipedia:

def is_happy(k):
    s = set()
    while k != 1:
        digits = [int(i) for i in str(k)]
        k = sum([i**2 for i in digits])
        if k in s:
            return False
        s.add(k)
    return True

We first need a way to compute the "sum of the squares of its digits". We will be assuming all calculations are in base 10. One method is to use "mod 10" to calculate the last digit, then compute "div 10" and repeat until you've exhausted all digits (e.g., the number is zero). We will be using the /mod ("divmod") word to compute both at once.

: squares ( n -- s )
    0 [ over 0 > ] [ [ 10 /mod sq ] dip + ] while nip ;

You can show this works (e.g., 125 = 1² + 2² + 5² = 30):

( scratchpad ) 125 squares .
30

There are two simple ways to detect a cycle. One involves keeping the "sum of the squares" in a set, checking each to see if its been seen before (like the Python example above). The other is similar to how you might detect a cycle in a singly linked list (also an occasional interview question): allocate two pointers and advance one twice as fast, if they ever point to the same object, it's a cycle. I chose to implement the latter method.

: (happy?) ( n1 n2 -- ? )
    [ squares ] [ squares squares ] bi* {
        { [ dup 1 = ] [ 2drop t ] }
        { [ 2dup = ] [ 2drop f ] }
        [ (happy?) ]
    } cond ;

: happy? ( n -- ? )
    dup (happy?) ;

The happy numbers under 50 can be easily calculated:

( scratchpad ) 50 iota [ happy? ] filter .
V{ 1 7 10 13 19 23 28 31 32 44 49 }

We can use the math.primes vocabulary to check for "happy primes" under 200:

( scratchpad ) 200 iota [ [ happy? ] [ prime? ] bi and ] filter .
V{ 7 13 19 23 31 79 97 103 109 139 167 193 }

Using Factor's support for large numbers, we can even check one of the large number claims that are made on the Wikipedia page:

"The palindromic prime 10^150,006 + 7426247 × 10^75,000 + 1 is also a happy prime with 150,007 digits..."

Waiting just a little while for the result (since its a rather large number), we see that it is indeed a happy number:

( scratchpad ) 10 150006 ^ 7426247 10 75000 ^ * 1 + + happy? .
t

The code for this is in my Github.

Text-or-Binary?

Sometimes it is useful to be able to tell if a file should be treated as a stream of text or binary characters. Rather than use the file extension (which might be missing or wrong), Subversion has a simple heuristic based on the file contents:

Currently, Subversion just looks at the first 1024 bytes of the file; if any of the bytes are zero, or if more than 15% are not ASCII printing characters, then Subversion calls the file binary.

Someone implemented this in a library written in Clojure. Here's my take, but in Factor.

Some vocabularies we will use, and a namespace:

USING: io io.encodings.binary io.files kernel math sequences ;

IN: text-or-binary

Checking if any of the bytes are zero:

: includes-zeros? ( seq -- ? )
    0 swap member? ;

The first 32 characters (e.g., 0-31) of ASCII are reserved for non-printing control characters. Checking that a majority (over 85%) of characters are printable (and assuming an empty sequence is printable):

: majority-printable? ( seq -- ? )
    [ t ] [ 
        [ [ 31 > ] count ] [ length ] bi / 0.85 >
    ] if-empty ;

Then, determining a sequence of bytes is text:

: text? ( seq -- ? )
    [ includes-zeros? not ] [ majority-printable? ] bi and ;

And implementing the operation to check if a file is text or binary:

: text-file? ( path -- ? )
    binary [ 1024 read text? ] with-file-reader ;

Using it is pretty easy:

( scratchpad ) "/usr/share/dict/words" text-file? .
t

( scratchpad ) "/bin/sh" text-file? .
f

The code for this (and some tests) is available on my Github.

HAMURABI

A few days ago, a programming challenge was made to port a game called HAMURABI from BASIC to a modern programming language.

Obviously, I thought Factor would be a fun contribution.

Warning: there are some spoilers below. If you plan on implementing this on your own from scratch, you might not want to read further.

The game consists of a simple concept. You are governor of "ANCIENT SUMERIA" and are responsible for certain yearly operations:

• managing the purchase or sale of land,
• feeding your people from stored food,
• and planting seeds to grow food for the future.

Depending on how well you do, you might be lauded, hated, or even impeached over the course of your 10-year term in office.

One way of thinking about a problem is to start from the outermost process: welcome the user, create a game, run 10 years, and then finish with a summary. This can be expressed pretty directly:

: hamurabi ( -- )
    welcome <game> 10 [ year ] times finish ;

The main game logic is in the year word and consists of a series of steps:

: year ( game -- game )
    [ 1 + ] change-year
    report-status
    update-randomness
    trade-land
    feed-people
    plant-seeds
    update-stores
    update-births
    update-deaths
    check-plague
    check-starvation ;

The entire solution (about 250 lines of code) is available on my Github. Other solutions have been contributed including Java (150 lines), Lua (185 lines), and Common Lisp (190 lines).

You can run it from the command line:

$ ./factor -run=hamurabi

Or, you can run it from the listener:

( scratchpad ) "hamurabi" run
                                HAMURABI
               CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY



TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA
SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE

HAMURABI:  I BEG TO REPORT TO YOU,
IN YEAR 1, 0 PEOPLE STARVED, 5 CAME TO THE CITY
POPULATION IS NOW 100.
THE CITY NOW OWNS 1000 ACRES.
YOU HARVESTED 3 BUSHELS PER ACRE.
RATS ATE 200 BUSHELS.
YOU NOW HAVE 2800 BUSHELS IN STORE.
...