a)How many different numbers can you spell using some of the letters of the word interchangeability?
b)Can you find another word providing a higher quantity of numbers?
Part a)
DECLARE FUNCTION verify2! (s1$, s2$)
DECLARE FUNCTION verify! (s1$, s2$)
DECLARE SUB ProcPiece (piece$, MajorPower!)
DATA one,two,three,four,five,six,seven,eight,nine
DATA ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen
DATA eighteen,nineteen
DATA twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety
DATA thousand,million,billion,trillion,quadrillion,quintillion,sextillion
DIM SHARED unit$(19), ten$(10), major$(7)
FOR i = 1 TO 19
READ unit$(i)
NEXT
FOR i = 2 TO 9
READ ten$(i)
NEXT
FOR i = 1 TO 7
READ major$(i)
NEXT
DIM SHARED name$, num$
CLS
FOR n = 1 TO 999
' IF n / 10 = INT(n / 10) THEN PRINT n;
num$ = LTRIM$(RTRIM$(STR$(n)))
IF num$ = "0" THEN
name$ = "zero"
ELSE
name$ = ""
MajorPower = 0
DO
l = LEN(num$): IF l > 3 THEN l = 3
piece$ = RIGHT$(num$, l)
num$ = LEFT$(num$, LEN(num$) - l)
CALL ProcPiece(piece$, MajorPower)
MajorPower = MajorPower + 1
LOOP WHILE LEN(num$) > 0
END IF
name$ = UCASE$(name$)
' PRINT name$;
DO
i = verify(name$, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
IF i THEN name$ = LEFT$(name$, i - 1) + MID$(name$, i + 1)
LOOP UNTIL i = 0
' PRINT " "; name$
IF verify(name$, "INTERCHANGEABILITY") = 0 THEN
PRINT name$;
IF verify2(name$, "INTERCHANGEABILITY") > 0 THEN PRINT "*";
PRINT
END IF
NEXT
SUB ProcPiece (piece$, MajorPower)
piece = VAL(piece$)
n$ = ""
IF piece > 99 THEN
n$ = unit$(piece \ 100) + " hundred "
piece = piece MOD 100
END IF
IF piece > 19 THEN
n$ = n$ + ten$(piece \ 10)
piece = piece MOD 10
IF piece > 0 THEN n$ = n$ + "-": ELSE n$ = n$ + " "
END IF
IF piece > 0 THEN n$ = n$ + unit$(piece) + " "
IF n$ > "" THEN name$ = n$ + major$(MajorPower) + " " + name$
END SUB
FUNCTION verify (s1$, s2$)
FOR i = 1 TO LEN(s1$)
IF INSTR(s2$, MID$(s1$, i, 1)) = 0 THEN verify = i: EXIT FUNCTION
NEXT
verify = 0
END FUNCTION
FUNCTION verify2 (s1$, s2$)
s$ = s2$
FOR i = 1 TO LEN(s1$)
ix = INSTR(s$, MID$(s1$, i, 1))
IF ix = 0 THEN verify2 = i: EXIT FUNCTION
s$ = LEFT$(s$, ix - 1) + MID$(s$, ix + 1)
NEXT
verify2 = 0
END FUNCTION
checks numbers only up to 999. This shouldn't be a problem as it has no letter O.
It finds 11 definite matches and 8 more that would require more than the given number of occurrences of some letter than occur in INTERCHANGEABILITY, such as EIGHTEEN, which requires 3 E's while INTERCHANGEABILITY has only 2. These number words are marked with an * below:
THREE
EIGHT
NINE
TEN
THIRTEEN
EIGHTEEN*
NINETEEN*
THIRTY
THIRTYTHREE*
THIRTYEIGHT*
THIRTYNINE
EIGHTY
EIGHTYTHREE*
EIGHTYEIGHT*
EIGHTYNINE
NINETY
NINETYTHREE*
NINETYEIGHT
NINETYNINE*
Part b)
The following program looks for words with more numbers. I've limited the counts to those of numbers under 1000 again.
DECLARE FUNCTION verify2! (s1$, s2$)
DECLARE FUNCTION verify! (s1$, s2$)
DECLARE SUB ProcPiece (piece$, MajorPower!)
DATA one,two,three,four,five,six,seven,eight,nine
DATA ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen
DATA eighteen,nineteen
DATA twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety
DATA thousand,million,billion,trillion,quadrillion,quintillion,sextillion
DIM SHARED unit$(19), ten$(10), major$(7)
FOR i = 1 TO 19
READ unit$(i)
NEXT
FOR i = 2 TO 9
READ ten$(i)
NEXT
FOR i = 1 TO 7
READ major$(i)
NEXT
DIM SHARED name$, num$
OPEN "\words\words.txt" FOR INPUT AS #1
CLS
DO
LINE INPUT #1, w$
w$ = UCASE$(w$)
goodct = 0: perfct = 0
FOR n = 1 TO 999
' IF n / 10 = INT(n / 10) THEN PRINT n;
num$ = LTRIM$(RTRIM$(STR$(n)))
IF num$ = "0" THEN
name$ = "zero"
ELSE
name$ = ""
MajorPower = 0
DO
l = LEN(num$): IF l > 3 THEN l = 3
piece$ = RIGHT$(num$, l)
num$ = LEFT$(num$, LEN(num$) - l)
CALL ProcPiece(piece$, MajorPower)
MajorPower = MajorPower + 1
LOOP WHILE LEN(num$) > 0
END IF
name$ = UCASE$(name$)
' PRINT name$;
DO
i = verify(name$, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
IF i THEN name$ = LEFT$(name$, i - 1) + MID$(name$, i + 1)
LOOP UNTIL i = 0
' PRINT " "; name$
IF verify(name$, w$) = 0 THEN
goodct = goodct + 1
IF verify2(name$, w$) = 0 THEN perfct = perfct + 1
END IF
NEXT
IF goodct >= maxgood THEN maxgood = goodct: maxgw$ = w$: PRINT w$, goodct
IF perfct >= maxperf THEN maxperf = perfct: maxpw$ = w$: PRINT " "; w$, perfct
LOOP UNTIL EOF(1)
SUB ProcPiece (piece$, MajorPower)
piece = VAL(piece$)
n$ = ""
IF piece > 99 THEN
n$ = unit$(piece \ 100) + " hundred "
piece = piece MOD 100
END IF
IF piece > 19 THEN
n$ = n$ + ten$(piece \ 10)
piece = piece MOD 10
IF piece > 0 THEN n$ = n$ + "-": ELSE n$ = n$ + " "
END IF
IF piece > 0 THEN n$ = n$ + unit$(piece) + " "
IF n$ > "" THEN name$ = n$ + major$(MajorPower) + " " + name$
END SUB
FUNCTION verify (s1$, s2$)
FOR i = 1 TO LEN(s1$)
IF INSTR(s2$, MID$(s1$, i, 1)) = 0 THEN verify = i: EXIT FUNCTION
NEXT
verify = 0
END FUNCTION
FUNCTION verify2 (s1$, s2$)
s$ = s2$
FOR i = 1 TO LEN(s1$)
ix = INSTR(s$, MID$(s1$, i, 1))
IF ix = 0 THEN verify2 = i: EXIT FUNCTION
s$ = LEFT$(s$, ix - 1) + MID$(s$, ix + 1)
NEXT
verify2 = 0
END FUNCTION
It finds the word that allows the most number words while keeping to the number of occurrences of each letter in the original word, to be HYPERPIGMENTATION, with 14.
When extra occurrences are allowed for the letters beyond the number found in the original word, the most is 79, by using THUNDERINGLY.
HYPERPIGMENTATION has 14 number words that can be formed while keeping within the counts of each letter, and 9 more that require more occurrences than in the word (*'ed items):
ONE
THREE
EIGHT
NINE
TEN
THIRTEEN
EIGHTEEN*
NINETEEN*
THIRTY
THIRTYONE
THIRTYTHREE*
THIRTYEIGHT*
THIRTYNINE
EIGHTY
EIGHTYONE
EIGHTYTHREE*
EIGHTYEIGHT*
EIGHTYNINE
NINETY
NINETYONE*
NINETYTHREE*
NINETYEIGHT
NINETYNINE*
From THUNDERINGLY there are 79 number words, but most need more occurrences of letters than appear in the word (only 5 stay within all letter counts).
THREE*
EIGHT
NINE
TEN
THIRTEEN*
EIGHTEEN*
NINETEEN*
THIRTY*
THIRTYTHREE*
THIRTYEIGHT*
THIRTYNINE*
EIGHTY
EIGHTYTHREE*
EIGHTYEIGHT*
EIGHTYNINE*
NINETY
NINETYTHREE*
NINETYEIGHT*
NINETYNINE*
THREEHUNDRED*
THREEHUNDREDTHREE*
THREEHUNDREDEIGHT*
THREEHUNDREDNINE*
THREEHUNDREDTEN*
THREEHUNDREDTHIRTEEN*
THREEHUNDREDEIGHTEEN*
THREEHUNDREDNINETEEN*
THREEHUNDREDTHIRTY*
THREEHUNDREDTHIRTYTHREE*
THREEHUNDREDTHIRTYEIGHT*
THREEHUNDREDTHIRTYNINE*
THREEHUNDREDEIGHTY*
THREEHUNDREDEIGHTYTHREE*
THREEHUNDREDEIGHTYEIGHT*
THREEHUNDREDEIGHTYNINE*
THREEHUNDREDNINETY*
THREEHUNDREDNINETYTHREE*
THREEHUNDREDNINETYEIGHT*
THREEHUNDREDNINETYNINE*
EIGHTHUNDRED*
EIGHTHUNDREDTHREE*
EIGHTHUNDREDEIGHT*
EIGHTHUNDREDNINE*
EIGHTHUNDREDTEN*
EIGHTHUNDREDTHIRTEEN*
EIGHTHUNDREDEIGHTEEN*
EIGHTHUNDREDNINETEEN*
EIGHTHUNDREDTHIRTY*
EIGHTHUNDREDTHIRTYTHREE*
EIGHTHUNDREDTHIRTYEIGHT*
EIGHTHUNDREDTHIRTYNINE*
EIGHTHUNDREDEIGHTY*
EIGHTHUNDREDEIGHTYTHREE*
EIGHTHUNDREDEIGHTYEIGHT*
EIGHTHUNDREDEIGHTYNINE*
EIGHTHUNDREDNINETY*
EIGHTHUNDREDNINETYTHREE*
EIGHTHUNDREDNINETYEIGHT*
EIGHTHUNDREDNINETYNINE*
NINEHUNDRED*
NINEHUNDREDTHREE*
NINEHUNDREDEIGHT*
NINEHUNDREDNINE*
NINEHUNDREDTEN*
NINEHUNDREDTHIRTEEN*
NINEHUNDREDEIGHTEEN*
NINEHUNDREDNINETEEN*
NINEHUNDREDTHIRTY*
NINEHUNDREDTHIRTYTHREE*
NINEHUNDREDTHIRTYEIGHT*
NINEHUNDREDTHIRTYNINE*
NINEHUNDREDEIGHTY*
NINEHUNDREDEIGHTYTHREE*
NINEHUNDREDEIGHTYEIGHT*
NINEHUNDREDEIGHTYNINE*
NINEHUNDREDNINETY*
NINEHUNDREDNINETYTHREE*
NINEHUNDREDNINETYEIGHT*
NINEHUNDREDNINETYNINE*
|
Posted by Charlie
on 2013-06-21 18:25:47 |