[ planet-factor ]

John Benediktsson: Time My Meeting

Recently, I bumped into Time My Meeting, a cute website that runs a timer for how long a meeting has run and then shows you a fun comparison versus something memorable that has taken a similar amount of time.

I thought it might make a nice demo in Factor:

Our program starts with a list of things that take time and how many milliseconds they take:

CONSTANT: THINGS-THAT-TAKE-TIME {
    ! <10 seconds
    { "A single frame of a film" 100 }
    { "It would take light to go around the Earth" 133 }
    { "A blink of an eye" 400 }
    { "The time it takes light to reach Earth from the moon" 1255 }
    { "The fastest Formula 1 pit stop" 1820 }
    { "The fastest 1/4 mile drag race time" 3580 }
    { "The fastest Rubik's cube solve" 4221 }
    { "The fastest 40-yard time at the NFL Combine" 4240 }
    { "The fastest 1 liter beer chug" 4370 }
    { "A skippable Youtube ad" 5000 }
    { "A full bull ride" 8000 }
    { "The fastest 100m sprint" 9580 }

    ! 10 Seconds
    { "The Wright Brothers first flight" 12000 }
    { "The fastest 200m sprint" 19190 }
    { "The fastest 50m freestyle swim lap" 21300 }
    { "The Westminster Kennel Club dog agility record" 28440 }
    { "A typical television ad" 30000 }
    { "The fastest NASCAR lap at Daytona" 40364 }
    { "The fastest 400m sprint" 43030 }
    { "The fastest NASCAR lap at Talladega" 44270 }
    { "The fastest 100m freestyle swim lap" 47050 }
}

We need a small word to turn those milliseconds into a useful string:

: human-time ( milliseconds -- string )
    1000 / dup 60 <
    [ "%.1f seconds" sprintf ]
    [ seconds duration>human-readable ] if ;

We may also need to know what the next thing that takes time will be, based on the total elapsed time:

: next-thing-that-takes-time ( elapsed-millis -- elt )
    THINGS-THAT-TAKE-TIME [ second < ] with find nip ;

Command-Line

First, we are going to make a simple word to run this on the command-line, iterating through the things that take time and then sleeping the appropriate amount of time, and then printing them out as they pass:

: time-my-meeting. ( -- )
    now THINGS-THAT-TAKE-TIME [
        [ milliseconds pick time+ sleep-until ]
        [ human-time "%s (%s)\n" printf flush ] bi
    ] assoc-each drop ;

You can run it and get something like this:

IN: scratchpad time-my-meeting.
A single frame of a film (0.1 seconds)
It would take light to go around the Earth (0.1 seconds)
A blink of an eye (0.4 seconds)
The time it takes light to reach Earth from the moon (1.3 seconds)
The fastest Formula 1 pit stop (1.8 seconds)
The fastest 1/4 mile drag race time (3.6 seconds)
The fastest Rubik's cube solve (4.2 seconds)
The fastest 40-yard time at the NFL Combine (4.2 seconds)
The fastest 1 liter beer chug (4.4 seconds)
A skippable Youtube ad (5.0 seconds)
A full bull ride (8.0 seconds)
The fastest 100m sprint (9.6 seconds)
The Wright Brothers first flight (12.0 seconds)
...

User Interface

We are also going to build the interface shown above, starting with a gadget that stores a timer, a total elapsed time in milliseconds, and a meeting start timestamp.

TUPLE: meeting-gadget < track timer total start ;

There are different strategies for building user interfaces, depending on the data model, and how composable or how separate the elements being displayed are from each other.

In the interest of tutorials, I want to demonstrate one strategy below that uses local variables to bind the elements to each other, allowing them to be updated in a kind of reactive manner. It is a long word, but the structure of the code matches somewhat to the rendered output that we are going for.

:: <meeting-gadget> ( -- gadget )
    vertical meeting-gadget new-track dup :> meeting
        COLOR: #f7f08b <solid> >>interior
        0 >>total

        "" <label> :> current-text
        "" <label> :> current-time

        "" <label> :> total-time
        "" <label> :> start-time

        THINGS-THAT-TAKE-TIME first first2 human-time
        [ <label> ] bi@ :> ( next-text next-time )

        [
            meeting total>>
            meeting [ now dup ] change-start drop swap time- duration>milliseconds +
            dup meeting total<<

            dup next-thing-that-takes-time first2
            over next-text string>> = [ 2drop ] [
                next-text string>> current-text string<<
                next-time string>> current-time string<<
                human-time
                next-time string<<
                next-text string<<
            ] if

            human-time total-time string<<
        ] f 100 milliseconds <timer> >>timer

        vertical <track>
            current-text f track-add
            current-time f track-add
        "This meeting is longer than..." <labeled-gadget> f track-add

        vertical <track>
            total-time f track-add
            start-time f track-add
        "It has been going on for..." <labeled-gadget> f track-add

        vertical <track>
            next-text f track-add
            next-time f track-add
        "The next milestone is..." <labeled-gadget> f track-add

        "Start" <label> :> start-label
        "Reset" <label> :> reset-label

        horizontal <track>
            start-label [
                drop
                meeting
                dup start>> [
                    0 >>total now timestamp>hms
                    "Started at " prepend start-time string<<
                ] unless
                now >>start
                timer>> dup thread>>
                [ stop-timer "Resume" start-label string<< ]
                [ start-timer "Pause" start-label string<< ] if
            ] <border-button> f track-add

            reset-label [
                drop
                meeting 0 >>total f >>start timer>> stop-timer
                "Start" start-label string<<
                "" current-text string<<
                "" current-time string<<
                "" total-time string<<
                "" start-time string<<
                THINGS-THAT-TAKE-TIME first first2 human-time
                next-time string<<
                next-text string<<
            ] <border-button> f track-add
        f track-add ;

And, then a main entrypoint to open a window when the vocabulary is run:

MAIN-WINDOW: time-my-meeting
    { { title "Time My Meeting" } }
    <meeting-gadget> >>gadgets ;

With a smidge of improved fonts and better gadget spacing, this is now available in my GitHub.

You can try it out!

Thu, 2 May 2024 03:00:00

John Benediktsson: Factor Language Tutorial

A few days ago, one of our Factor Discord server members posted a video tutorial that they made for Factor. It is a pretty neat hour long introduction going over a lot of features that users new to the language might be interested in:

This is an introductory tutorial for a stack-based (concatenative) programming language Factor. It covers some basic language constructs and a few features of the interactive development environment that is shipped with Factor.

You can watch it here:

Sun, 28 Apr 2024 16:00:00

John Benediktsson: Reverse Vowels

Our task today is to “reverse vowels of a string”. This sounds like (and probably is) a coding interview question as well as a LeetCode problem, a Codewars kata, and the second task in the Perl Weekly Challenge #254.

If you don’t want spoilers, maybe stop reading here!

We are going to use Factor to solve this problem as well as a variant that is a bit more challenging.

Let’s Reverse The Vowels

One of the benefits of the monorepo approach that we have taken to building the extensive Factor standard library is developing higher-level words that solve specific kind of tasks.

One of those is arg-where – currently in the miscellaneous sequences.extras vocabulary – which we can use to find all the indices in a string that contain a vowel?:

IN: scratchpad "hello" [ vowel? ] arg-where .
V{ 1 4 }

We’ll want to group the beginning and ending indices, ignoring the middle index if the number of indices is odd since it would not change:

: split-indices ( indices -- head tail )
    dup length 2/ [ head-slice ] [ tail-slice* ] 2bi ;

We can then build a word to reverse specified indices:

: reverse-indices ( str indices -- str )
    split-indices <reversed> [ pick exchange ] 2each ;

And then use it to reverse the vowels:

: reverse-vowels ( str -- str )
    dup >lower [ vowel? ] arg-where reverse-indices ;

And see how it works:

IN: scratchpad "factor" reverse-vowels .
"foctar"

IN: scratchpad "concatenative" reverse-vowels .
"cencitanetavo"

Pretty cool!

Let’s Reverse The Vowels, Maintain The Case

A somewhat more challenging task is to reverse the vowels, and to swap their letter case.

Let’s start by building a word to swap the case of two letters:

: swap-case ( a b -- a' b' )
    2dup [ letter? ] bi@ 2array {
        { { t f } [ [ ch>upper ] [ ch>lower ] bi* ] }
        { { f t } [ [ ch>lower ] [ ch>upper ] bi* ] }
        [ drop ]
    } case ;

And then another word to exchange two indices, but also swap their case:

: exchange-case ( i j seq -- )
    [ '[ _ nth ] bi@ swap-case ]
    [ '[ _ set-nth ] bi@ ] 3bi ; inline

A word to reverse the indices, but also swap their case:

: reverse-indices-case ( str indices -- str )
    split-indices <reversed> [ pick exchange-case ] 2each ;

And, finally, a word to reverse the vowels, but also swap their case:

: reverse-vowels-case ( str -- str )
    dup >lower [ vowel? ] arg-where reverse-indices-case ;

And then see how it works:

IN: scratchpad "FActor" reverse-vowels-case .
"FOctar"

A pretty fun problem!

Mon, 12 Feb 2024 19:00:00

John Benediktsson: Dragonbox

One of the challenging problems in computer science is to efficiently take a binary representation of a floating-point number and convert it to the “shortest decimal representation” that will roundtrip back to the same floating-point number when it is parsed.

A few days ago, one of the members of the Factor Discord server posted about an issue they were having where three separate floating-point numbers printed as the same decimal value:

IN: scratchpad 0x1.1ffffffffffffp7 .
144.0

IN: scratchpad 0x1.2p7 .
144.0

IN: scratchpad 0x1.2000000000001p7 .
144.0

Well, that’s not ideal!

And you can see that in other languages like Python, they parse properly into three distinct values:

>>> float.fromhex('0x1.1ffffffffffffp7')
143.99999999999997

>>> float.fromhex('0x1.2p7')
144.0

>>> float.fromhex('0x1.2000000000001p7')
144.00000000000003

In the process of investigating this issue, I re-discovered a few algorithms that have been developed to do this. There is a neat project called Drachennest that investigates the relative performance of several of these algorithms and claims:

Grisu3, Ryu, Schubfach, and Dragonbox are optimal, i.e. the output string

rounds back to the input number when read in,

is as short as possible,

is as close to the input number as possible.

Well, it turns out that the “Dragonbox” algorithm is one of the current best and is described in a paper called A New Floating-Point Binary-to-Decimal Conversion Algorithm as well as a fantastic reference implementation of Dragonbox in C++.

I was able to quickly fix the bug by temporarily using a “modern formatting library” called {fmt} that works in C++11 and provides a version of the C++20 function std::format, but thought it would be a good idea to implement the Dragonbox algorithm someday in pure Factor code and filed an issue to track that idea.

Well, one of our awesome contributors, Giftpflanze, jumped in and implemented Dragonbox in Factor – providing a very readable and understandable and nicely concatenative version – and it was merged today!

Not only does this solve the issue of decimal representation of floats, but it provides quite a large speedup to our float-parsing benchmark:

Currently in Factor 0.99:

IN: scratchpad gc [ parse-float-benchmark ] time
Running time: 3.181906583 seconds

And now after the patch:

IN: scratchpad gc [ parse-float-benchmark ] time
Running time: 0.378132792 seconds

Very impressive!

I’m excited to say that this is now available in the development version of Factor.

Mon, 12 Feb 2024 02:30:00

John Benediktsson: Divmods

There’s a discussion on support multiple divisors in divmod() on the Python.

So instead of

minutes, seconds = divmod(t, 60)
hours, minutes = divmod(minutes, 60)
days, hours = divmod(hours, 24)
weeks, days = divmod(days, 7)

you could write:

weeks, days, hours, minutes, seconds = divmod(t, 7, 24, 60, 60)

Sample implementation:

def new_divmod(dividend, *divisors):
    if not divisors:
        raise TypeError('required at least one divisor')
    remainders = []
    for divisor in reversed(divisors):
        dividend, remainder = old_divmod(dividend, divisor)
        remainders.append(remainder)
    return (dividend, *remainders[::-1])

Along with the sample implementation in Python above, the original author provides some thoughts on whether the order of arguments should be reversed or not, and some of the comments in the thread discuss various implementation details and some other use-cases for this approach.

You can see how it might work by trying the code:

>>> new_divmod(1234567, 7, 24, 60, 60)
(2, 0, 6, 56, 7)

Okay, so how might we do this in Factor?

Well, our version of divmod is /mod and we could just run it a few times to get the result:

IN: scratchpad 1234567 60 /mod swap 60 /mod swap 24 /mod swap 7 /mod swap

--- Data stack:
7
56
6
0
2

Alternatively, we could pass the arguments as a sequence and return the result as a sequence:

IN: scratchpad 1234567 { 60 60 24 7 } [ /mod ] map swap suffix

--- Data stack:
{ 7 56 6 0 2 }

Or, perhaps, we could make a macro, taking the input argument as a sequence, but generating code to put the result onto the stack:

MACRO: /mods ( seq -- quot )
    [ '[ _ /mod swap ] ] map concat ;

And then use it:

IN: scratchpad 1234567 { 60 60 24 7 } /mods

--- Data stack:
7
56
6
0
2

Kind of an interesting idea!

Fri, 2 Feb 2024 15:00:00

John Benediktsson: Crontab

Cron might be the latest, greatest, and coolest “next-generation calendar” as well as now a product called Notion Calendar. But in the good ol’ days, cron was instead known as:

The cron command-line utility is a job scheduler on Unix-like operating systems. Users who set up and maintain software environments use cron to schedule jobs (commands or shell scripts), also known as cron jobs, to run periodically at fixed times, dates, or intervals. It typically automates system maintenance or administration—though its general-purpose nature makes it useful for things like downloading files from the Internet and downloading email at regular intervals.

There are implementations of crond – the cron daemon – on most operating systems. Many of them have standardized on a crontab format that looks something like this:

# ┌───────────── minute (0–59)
# │ ┌───────────── hour (0–23)
# │ │ ┌───────────── day of the month (1–31)
# │ │ │ ┌───────────── month (1–12)
# │ │ │ │ ┌───────────── day of the week (0–6) (Sunday to Saturday;
# │ │ │ │ │                                   7 is also Sunday on some systems)
# │ │ │ │ │
# │ │ │ │ │
# * * * * * <command to execute>

At first (and sometimes second and third and fourth) glance, this looks a bit inscrutable, and so websites such as crontab guru pop up to help you unpack and explain when a cronentry is expected to be run.

I thought it would be fun to build a parser for these cronentries in Factor.

Let’s start by defining a cronentry type:

TUPLE: cronentry minutes hours days months days-of-week command ;

For each component, there is a variety of allowed inputs:

all values in the range: *
list of values: 3,5,7
range of values: 10-15
step values: 1-20/5
random value in range: 10~30

We build a parse-value word that will take an input string, a quot to parse the input, and a seq of possible values, as well as a parse-range word to help with optional starting and ending input values.

:: parse-range ( from/f to/f quot: ( input -- value ) seq -- from to )
    from/f [ seq first ] quot if-empty
    to/f [ seq last ] quot if-empty ; inline

:: parse-value ( input quot: ( input -- value ) seq -- value )
    input {
        { [ dup "*" = ] [ drop seq ] }

        { [ CHAR: , over member? ] [
            "," split [ quot seq parse-value ] map concat ] }

        { [ CHAR: / over member? ] [
            "/" split1 [
                quot seq parse-value dup length 1 =
                [ seq swap first seq index seq length ]
                [ 0 over length ] if 1 -
            ] dip string>number <range> swap nths ] }

        { [ CHAR: - over member? ] [
            "-" split1 quot seq parse-range [a..b] ] }

        { [ CHAR: ~ over member? ] [
            "~" split1 quot seq parse-range [a..b] random 1array ] }

        [ quot call 1array ]
    } cond members sort ; inline recursive

We can then make parse-cronentry to parse the entry description, handling days and months differently to allow their abbreviations to be passed as input (e.g., sun for Sunday or jan for January).

: parse-day ( str -- n )
    [ string>number dup 7 = [ drop 0 ] when ] [
        >lower $[ day-abbreviations3 [ >lower ] map ] index
    ] ?unless ;

: parse-month ( str -- n )
    [ string>number ] [
        >lower $[ month-abbreviations [ >lower ] map ] index
    ] ?unless ;

: parse-cronentry ( entry -- cronentry )
    " " split1 " " split1 " " split1 " " split1 " " split1 {
        [ [ string>number ] T{ range f 0 60 1 } parse-value ]
        [ [ string>number ] T{ range f 0 24 1 } parse-value ]
        [ [ string>number ] T{ range f 1 31 1 } parse-value ]
        [ [ parse-month ] T{ range f 1 12 1 } parse-value ]
        [ [ parse-day ] T{ circular f T{ range f 0 7 1 } 1 } parse-value ]
        [ ]
    } spread cronentry boa ;

We can try using it to see what a parsed cronentry looks like:

IN: scratchpad "20-30/5 5 */5 * * /path/to/command" parse-cronentry .
T{ cronentry
    { minutes { 20 25 30 } }
    { hours { 5 } }
    { days { 1 6 11 16 21 26 31 } }
    { months { 1 2 3 4 5 6 7 8 9 10 11 12 } }
    { days-of-week { 0 1 2 3 4 5 6 } }
    { command "/path/to/command" }
}

Now that we have that working, we can use it to calculate the next-time-after a given timestamp that the cronentry will trigger, applying a waterfall to rollover the timestamp until a valid one is found:

:: (next-time-after) ( cronentry timestamp -- )

    f ! should we keep searching for a matching time

    timestamp month>> :> month
    cronentry months>> [ month >= ] find nip
    dup month = [ drop ] [
        [ cronentry months>> first timestamp 1 +year drop ] unless*
        timestamp 1 >>day 0 >>hour 0 >>minute month<< drop t
    ] if

    timestamp day-of-week :> weekday
    cronentry days-of-week>> [ weekday >= ] find nip [
        cronentry days-of-week>> first 7 +
    ] unless* weekday - :> days-to-weekday

    timestamp day>> :> day
    cronentry days>> [ day >= ] find nip [
        cronentry days>> first timestamp days-in-month +
    ] unless* day - :> days-to-day

    cronentry days-of-week>> length 7 =
    cronentry days>> length 31 = 2array
    {
        { { f t } [ days-to-weekday ] }
        { { t f } [ days-to-day ] }
        [ drop days-to-weekday days-to-day min ]
    } case [
        timestamp 0 >>hour 0 >>minute swap +day 2drop t
    ] unless-zero

    timestamp hour>> :> hour
    cronentry hours>> [ hour >= ] find nip
    dup hour = [ drop ] [
        [ cronentry hours>> first timestamp 1 +day drop ] unless*
        timestamp 0 >>minute hour<< drop t
    ] if

    timestamp minute>> :> minute
    cronentry minutes>> [ minute >= ] find nip
    dup minute = [ drop ] [
        [ cronentry minutes>> first timestamp 1 +hour drop ] unless*
        timestamp minute<< drop t
    ] if

    [ cronentry timestamp (next-time-after) ] when ;

: next-time-after ( cronentry timestamp -- timestamp )
    [ dup cronentry? [ parse-cronentry ] unless ]
    [ 1 minutes time+ 0 >>second ] bi*
    [ (next-time-after) ] keep ;

This is great, because we can find the next time that a cronentry will trigger. For example, if we wanted to specify something to trigger at midnight on every leap day:

IN: scratchpad "0 0 29 2 *" now next-time-after timestamp>rfc822 .
"Thu, 29 Feb 2024 00:00:00 -0800"

Or even, the next several times that the cronentry will trigger:

IN: scratchpad "0 0 29 2 *" now 5 [
                   dupd next-time-after [ timestamp>rfc822 . ] keep
               ] times 2drop
"Thu, 29 Feb 2024 00:00:00 -0800"
"Tue, 29 Feb 2028 00:00:00 -0800"
"Sun, 29 Feb 2032 00:00:00 -0800"
"Fri, 29 Feb 2036 00:00:00 -0800"
"Wed, 29 Feb 2040 00:00:00 -0800"

This is available in the crontab vocabulary including some features such as support for aliases (e.g., @daily and @weekly) and some higher-level words for working with crontabs and cronentries.

Wed, 31 Jan 2024 15:00:00

John Benediktsson: Codewars

Codewars is an online platform for learning programming languages by solving small programming exercises called “kata” and subsequently increasing your degree of proficiency via levels of “kyu”. It has useful features such as extensive unit tests, leaderboards, allies for allowing friendly competition, and discussion boards.

It supports an incredible number of programming languages – albeit some of these are in “beta” status – including Factor!

I wanted to draw attention to the Codewars website and point out that it has newly released support for Factor 0.99 due to great community support and some work on the Codewars test vocabulary that was developed specifically for use with the Codewars system.

It’s pretty fun to complete the katas and then see the solutions that other users have contributed.

Give it a try!

Mon, 29 Jan 2024 15:00:00

John Benediktsson: Special Numbers

Lots of numbers are special in various definitions of specialness. This often forms the basis of different programming challenges. In the case of the most recent Perl Weekly Challenge #252, the problem statement declares that a number is “special” in this way:

You are given an array of integers, @ints.

Write a script to find the sum of the squares of all special elements of the given array.

An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0, where n is the length of the given array. Also the array is 1-indexed for the task.

And it gives two examples, which we can use as test cases later when we solve this in Factor.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 21, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Solution

Let’s find the special indices – which are just the divisors of the length of the input sequence – and then take the elements at those special indices:

: special-numbers ( ints -- ints' )
    [ length divisors 1 v-n ] [ nths ] bi ;

And so, we can solve this problem for both provided examples:

{ 21 } [ { 1 2 3 4 } special-numbers sum-of-squares ] unit-test

{ 63 } [ { 2 7 1 19 18 3 } special-numbers sum-of-squares ] unit-test

And a “script”, if we wanted to take input from the command-line, as requested:

MAIN: [
    [ readln ] [
        split-words harvest [ string>number ] map
        dup special-numbers sum-of-squares
        "%u => %u\n" printf
    ] while*
]

Mon, 15 Jan 2024 15:00:00