Rebol3 Code Examplex

Lyndon word

Generate words that are strictly lexicographically smaller than all of their nontrivial rotations, a key concept in combinatorics on words.

Rebol [
    title: "Rosetta code: Lyndon word"
    file:  %Lyndon_word.r3
    url:   https://rosettacode.org/wiki/Lyndon_word
]

lyndon-words: function/with [
    "Prints Lyndon words"
    alphabet   [string!]
    max-length [integer!]
][
    print ["Lyndon words with max length" max-length "for alphabet" mold alphabet]
    word: copy/part alphabet 1
    while [not empty? word][
        print word
        word: next-word max-length word alphabet
    ]
    print ""
][
    next-word: function[
        "Using the Duval (1988) algorithm"
        max-length [integer!]
        word       [string!]
        alphabet   [string!]
    ][
        ;; Step 1: Repeat the word and truncate
        next-word: copy word
        append/dup next-word word max-length / next-word/length
        clear skip next-word max-length

        ;; Step 2: Remove last symbol of the next word if it is the last symbol in the alphabet
        alphabet-last-symbol: last alphabet
        while [alphabet-last-symbol == last next-word][take/last next-word]

        ;; Step 3: Replace the last symbol of the next word by its successor in the alphabet
        unless empty? next-word [
            word-last-symbol: take/last next-word
            append next-word second find alphabet word-last-symbol
        ]
        next-word
    ]
]

lyndon-words "01" 5
lyndon-words "012" 3

Output:

Lyndon words with max length 5 for alphabet "01"
0
00001
0001
00011
001
00101
0011
00111
01
01011
011
0111
01111
1

Lyndon words with max length 3 for alphabet "012"
0
001
002
01
011
012
02
021
022
1
112
12
122
2