[REBOL] Re: Hungarian Alphabet Sort (was Re: Collation sequence - proper and eff
From: nitsch-lists:netcologne at: 14-May-2002 12:09
Hi Scott, Gesa, Carl,
not sure if this helps, but since i spended some time to it,
i post ;)
rebol [title: "char-mapping"]
{
Hi Scott, Geza, Carl,
instead of creating the mapping fully by hand,
i created a little dialect, which creates a parse-rule.
(not a very efficient one currently. contest! ;)
just a demo, lacks all special chars currently.
}
mapper: context [
{===patch the default mapping with your local specialities}
customize-ascii: [
at "h" [+ "ch"]
at "H" [+ "CH" = "Ch"]
]
"===logical mapping to insert / change easily"
logical-mapping: copy [] 'like [.. + "G" + "H" + "CH" = "Ch" + "I" =2E.]
"fill with ascii (attention 0-based.. ;)"
repeat i 128 [
append logical-mapping compose [+ (to string! to char! i - 1)]
]
{now one could, for example,
exchange upper & lower chars with some rebol-moves}
"===evaluate 'customize, insert custom strings"
parse customize-ascii [some [
'at set string string! set block block! (
insert find/case/tail logical-mapping string block
)
]]
? logical-mapping
"===numbered mapping to have the translation-codes"
numbered-mapping: copy [] 'like [.. "G" 71 "H" 72 "CH" 73 "Ch" 73 "I" 74
=2E.]
next-char: -1
parse logical-mapping [some [
['+ (next-char: next-char + 1) | '=]
set string string! (repend numbered-mapping [string next-char])
]]
? numbered-mapping
"===mapping rule to translate"
mapping-rule: cp [] 'like
[.. | "CH" (insert tail out #"I") | "H" (insert tail out #"H") | ..]
{attention: parse needs the longest strings first, so we reverse!}
parse head reverse numbered-mapping [some [
set code integer! set string string! (
append mapping-rule reduce [
string to-paren compose [insert tail out (to-char code)]
'|
]
)
]]
remove back tail mapping-rule
? mapping-rule
"===and now the mapping-function"
out: none
map: func [string] [
out: cp ""
parse/all/case string [any mapping-rule]
out
]
mapped-sort: func [block /local buf] [
buf: cp []
foreach string block [repend buf [map string string]]
sort/skip buf 2
clear block
forskip buf 2 [append block second buf]
block
]
"===test"
probe mapped-sort [
"A string with H mapped"
"A string with I mapped"
"A string with CH mapped"
]
]
