Solution for T9 Spelling Problem in Caché ObjectScript

My result is 157 :)

Let see to the keypad again, it's getting obvious instantly that keys are (mostly) located by groups of 3 symbols, and if there would not be those "s" (corresponding to "7777") and "z" (which produces "9999") then implementation will be simple formula with division by 3 and corresponding modulo. Also space is exception and is not a part of sequential numerics.

So given this assumprion let us create the 1st approximation (no compression, not name reduction, everything ie readable and commented):

 0(s) public {
    set S=""
    for %=1:1:$length(s) {
        set P=""
        set c = $e(s,%)
        set i = $a(c) - $a("a")
        if c=" " { 
            set P="0"
        } elseif c="z" {
            set P="9999"
        } elseif c="s" {
            set P="7777"
        } elseif i<($a("s") - $a("a")) { // ($a("s") - $a("a")) = 18
            set n=i\3+1,m=i#3+1
            set before2 = $a("1") ; 49
            set $p(P,$c(n + before2),m+1)=""
        } else {
            set n=i-1\3+1,m=i-1#3+1
            set before2 = $a("1") ; 49
            set $p(P,$c(n + before2),m+1)=""
        }
        set:$extract(S,*)=$extract(P,1) S=S_" "
        set S=S_P
    }
    quit S
}

[Don't botther to count symbols - we will compress the code a bit]

This strange `set $piece(string,symbol,offset+1) = ""` is actually filling of a string with the given symbol.

Let us review those several ifs, we see, actually, 2 groups of them:

• 3 ifs for exceptions fom formulae;
• 2 ifs for disjointed rows of groupd by 3 keys. The formulae is atually the same, but witth some offset.

So let's get rid of ifs via $select and extra offset itroduced.

 #; get rid of ifs, replace with $selects
1(s) public {
    set S=""
    for %=1:1:$length(s) {
        set P=""
        set c = $e(s,%)
        set i = $a(c) - $a("a") ; $a("a")=97
        set o = i '< 18 ; ($a("s") - $a("a")) = 18
        set $p(P, $c(i - o\3+1 + $a("1")), i - o#3+1+1)=""
        set P=$select(c=" ": "0", 
                      c="z": "9999",
                      c="s": "7777",
                      1:P)
        set:$extract(S,*)=$extract(P,1) S=S_" "
        set S=S_P
    }
    quit S
}

[I believe this step is still obvious]

[[I dislike the way I had to put expressions without pairs but we need as short as possible, sothis is inevitable evil.]]

Now this is time to get shorter, but stiill readable version:

 #; name reduction
2(s) public {
    s S=""
    f %=1:1:$l(s) {
        s P=""
        s c = $e(s,%)
        s i = $a(c) - $a("a") ; $a("a")=97
        s o = i '< 18
        s $p(P, $c(i - o\3+1 + $a("1")), i - o#3+1+1)=""
        s P=$s(c=" ": "0", c="z": "9999", c="s": "7777", 1:P)
        s:$e(S,*)=$e(P,1) S=S_" "
        s S=S_P
    }
    q S
}

That was simple- select code in Studio, then press Ctrl+Shift+E. 

And the latest step, is to convert this barely readable code to 1 line mess hard-code stuff:

 #; linearization
3(s) public {
 s S="" f %=1:1:$l(s) {s P="",c=$e(s,%),i=$a(c)-97,o=i'<18,$p(P,$c(i-o\3+50),i-o#3+2)="",P=$s(c=" ":"0",c="z":"9999",c="s":"7777",1:P) s:$e(S,*)=$e(P,1) S=S_" " s S=S_P} q S
}

That's (if you count the 1st indent symbol) 173 characters length.

P.S.

Eduard Lebedyuk has improved this result a little bit:

• he has replaced quoted literals with numerics (because they are both represend canonical numerics
  from ObjectScript point of view);
• and replaced (where possiblle) comparisons of characters with comparisons of their derived ordinals (minus 97, or "a")

 #; +Eduard modifications
4(s) public {
 s S="" f %=1:1:$l(s){s P="",c=$e(s,%),i=$a(c)-97,o=i>17,$p(P,$c(i-o\3+50),i-o#3+2)=P,P=$s(i<0:0,i=25:9999,i=18:7777,1:P),S=S_$s($e(S,*)=$e(P):" "_P,1:P)} q S
}

We are 158 now!

I only managed to get my code down to 207 characters and it's even missing the whitespace->0 mapping, I saw that too late. Butwhoneedswhitespacestodayanyway?

In case you are curious here is my code:

 #define a(%x) $LG(o,$a($E(s,%x,%x))-96)
 s (x,o)="" f m=2:1:9{s r="" f n=1:1:$S(m=7:4,m=9:4,1:3){s r=r_m,o=o_$LB(r)}} f j=1:1:$L(s)-1{s x=x_$$$a(j) s:$E($$$a(j+1),1,1)=$E(x,$L(x),*) x=x_" "} q x_$$$a($L(s))

The first part actually builds a $LIST with the mapping from characters to the corresponding keypad sequence. The second part loops over the input string and does a lookup for the keypad sequence. A look-ahead checks if I have to add a whitespace to indicate a pause. Because of the look-ahead I have to treat the last character conversion outside of my main loop.

Tricks I used:

• Replace if statements with $SELECT
• Use SET statement to set multiple variables to the same values
• Built a macro for code you need multiple times (I need the lookup three times, in my main loop, for the look-ahead and for the last character conversion) 

Not an optimal algorithm and it's even lacking a piece, but still it is a fun exercise.

Here's my code, of course I could shrink this down a lot, but figured people might want to read it.

Personally, I think looking at different ways of doing the same thing are a great learning lesson.  Judging based on the length of the code, simply encourages bad programming.

ClassMethod toPhone(i As %String)
{
    set k="----abc-def-ghi-jkl-mno-pqrstuv-wxyz ---"
    set i=$zconvert(i,"L"),o=""
    f p=1:1:$l(i) s c=$e(i,p),d=$f(k,c)\4+1,r=3-(d*4-($f(k,c))) s:r<1 r=4+r,d=d-1 s:d>9 d=0 s z="",$p(z,d,r+1)="",o=o_$s($e(o,$l(o))=d:" ",1:"")_z
    q o
}

Yet another varaint of 148 characters length (for 8-bit instances only):

ClassMethod am(t) As %String [ ProcedureBlock = 1 ]
{
 s s="",a="!""#123ABCQRSabcqrstЃ‚ѓ‘’“”•" f i=1:1:$l(t){s p=$a(a,$a(t,i)-96),j=p\16 s:$e(s,*)=j s=s_" " s s=s_$s(j:$tr($j("",p#16)," ",j),1:0)} q s
}