61 lines
1.7 KiB
Mathematica
61 lines
1.7 KiB
Mathematica
LEXAS3 ; ISL Look-up Check Input (SHIFT) ; 09-23-96
|
|
;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
|
;
|
|
SHIFT(LEXX) ; Letters are shifted out of position
|
|
;
|
|
; LEXORG( Array of characters in the ORiGinal string
|
|
; LEXORD( Array of characters in the $O variable
|
|
; LEXE $E string
|
|
; LEXL Length
|
|
; LEXD Flag - Difference of strings
|
|
; LEXOK Flag - Shifted string is ok to use
|
|
; LEXO $O variable
|
|
; LEXI Incremental counter
|
|
; LEXX Returned value
|
|
;
|
|
;
|
|
Q:$L(LEXX)<5 LEXX
|
|
N LEXT,LEXE,LEXL,LEXO,LEXOK,LEXORG,LEXORD
|
|
S LEXT=LEXX,LEXOK=0
|
|
F LEXL=1:1:3 D SHF Q:LEXOK S LEXT=$E(LEXT,1,($L(LEXT)-1))
|
|
K LEXORG,LEXORD
|
|
S LEXX=LEXT
|
|
Q LEXX
|
|
;
|
|
SHF ; Shift letters in arrays
|
|
K LEXORG D ORG(LEXT)
|
|
S LEXE=$E(LEXT,1,2),LEXO=$$SCH^LEXAS6(LEXE)
|
|
F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:LEXO=""!(LEXO'[LEXE)!(LEXOK) D Q:LEXOK
|
|
. Q:$L(LEXO)<$L(LEXT)!($L(LEXO)>($L(LEXT)+1))
|
|
. N LEXD D ORD(LEXO) S LEXD=$$COMP
|
|
. I LEXD S LEXOK=0 Q
|
|
. I 'LEXD S LEXT=LEXO,LEXOK=1 Q
|
|
Q
|
|
;
|
|
ORG(LEXX) ; Original tolken
|
|
K LEXORG N LEXI
|
|
F LEXI=1:1:$L(LEXX) D
|
|
. I $D(LEXORG($E(LEXX,LEXI))) D Q
|
|
. . S LEXORG($E(LEXX,LEXI))=LEXORG($E(LEXX,LEXI))+1
|
|
. S LEXORG($E(LEXX,LEXI))=1
|
|
Q
|
|
ORD(LEXO) ; Ordered tolken
|
|
K LEXORD N LEXI
|
|
F LEXI=1:1:$L(LEXO) D
|
|
. I $D(LEXORD($E(LEXO,LEXI))) D Q
|
|
. . S LEXORD($E(LEXO,LEXI))=LEXORD($E(LEXO,LEXI))+1
|
|
. S LEXORD($E(LEXO,LEXI))=1
|
|
Q
|
|
COMP(LEXX) ; Compare Original to Ordered
|
|
N LEXI,LEXD S LEXI="",LEXD=1
|
|
F S LEXI=$O(LEXORG(LEXI)) Q:LEXI="" D Q:'LEXD
|
|
. I '$D(LEXORD(LEXI)) S LEXD=0 Q
|
|
. I LEXORG(LEXI)>LEXORD(LEXI) S LEXD=0
|
|
I LEXD=0 K LEXORD Q 1
|
|
S LEXI="",LEXD=1
|
|
F S LEXI=$O(LEXORD(LEXI)) Q:LEXI="" D Q:'LEXD
|
|
. ;I '$D(LEXORG(LEXI)) Q
|
|
. I LEXORD(LEXI)>($G(LEXORG(LEXI))+1) S LEXD=0
|
|
I LEXD=0 K LEXORD Q 1
|
|
K LEXORD Q 0
|