On 15-May-02, G. Scott Jones wrote:

> From: "Volker Nitsch"
> ...
>> not sure if this helps, but since i spended some time to it,
>> i post ;)

> <snipped code>

> Hi, Volker,

> Neat idea. Kind of like a good cut of beef, I'm going to have to
> chew on it a bit to fully understand its potential. Thanks for the
> trans-atlantic volley ball pass.

Glad you could work it out, as I couldn't make head nor tail of it. (:

Anyway, I've played around with my idea for sorting according to a
pattern, and while I'm not sure if the following code's very fast (or
bug-free:), like Volker, I post.

There's two functions:  One to take a pattern for creating a rule from
and another to use the rule to sort strings or blocks of strings
with.  First, the functions...

pattern-rule: func [
    "Create a rule for use by pattern-sort."
    pattern [string! block!] "An ordered pattern."
    /local rule n
][
    rule: copy []
    n: 1
    forall pattern [
        append rule reduce [pattern/1 to-paren reduce ['r n] '|]
        n: n + 1
    ]
    append rule reduce ['skip to-paren reduce ['r n]]
    reduce ['some rule]
]

pattern-sort: func [
    {Sort a string or block of strings based on a rule created
     by pattern-rule.}
    series [string! block!] "Series to sort."
    rule [block!] "Pattern rule."
    /reverse "Reverse sort order."
    /local ptrs blk r pos val
][
    ptrs: copy []
    blk: copy []
    r: func [n][append/only blk n]
    bind rule 'r
    either string? series [
        parse/case series rule
        pos: 1
        foreach n blk [
            append/only ptrs reduce [
                n pick rule/2 (n - 1) * 3 + 1
            ]
            val: next first back tail ptrs
            if 'skip = val/1 [change val pick series pos]
            pos: pos + either char? val/1 [1][length? val/1] 
        ]
    ][
        forall series [
            clear blk
            parse/case series/1 rule
            append/only ptrs copy blk
            append last ptrs series/1
        ]
    ]
    either reverse [sort/reverse ptrs][sort ptrs]
    clear series
    forall ptrs [append series last ptrs/1]
    series
]

And some examples of use...

>> rule-1: pattern-rule "aAbBcC"
== [some [#"a" (r 1) | #"A" (r 2) | #"b" (r 3) | #"B" (r 4) | #"c" (r
5) | #"C" (r 6) | skip (r 7)]]
>> pattern-sort "AacCBb" rule-1
== "aAbBcC"
>> pattern-sort ["Abc" "abc" "aBC" "ABC"] rule-1
== ["abc" "aBC" "Abc" "ABC"]
>> pattern-sort/reverse ["Abc" "abc" "aBC" "ABC"] rule-1
== ["ABC" "Abc" "aBC" "abc"]

>> rule-2: pattern-rule "AaBbCc"
== [some [#"A" (r 1) | #"a" (r 2) | #"B" (r 3) | #"b" (r 4) | #"C" (r
5) | #"c" (r 6) | skip (r 7)]]
>> pattern-sort "AacCBb" rule-2
== "AaBbCc"
>> pattern-sort ["Abc" "abc" "aBC" "ABC"] rule-2
== ["ABC" "Abc" "aBC" "abc"]

>> rule-3: pattern-rule ["a" "A" "b" "B" "ch" "c" "C"]
== [some ["a" (r 1) | "A" (r 2) | "b" (r 3) | "B" (r 4) | "ch" (r 5) |
"c" (r 6) | "C" (r 7) | skip (r 8)]]
>> pattern-sort "abcABCchCbA" rule-3
== "aAAbbBchcCC"
>> pattern-sort ["AabA" "chab" "chAB" "cchc" "achA"]  rule-3
== ["achA" "AabA" "chab" "chAB" "cchc"]

It seems to work and might be of some use, but I'd test it well before
trusting it.  It's had no real-world tests at all...

-- 
Carl Read

-- 
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the 
subject, without the quotes.

Reply via email to