1
$\begingroup$

I am working with MaximizeOverPermutationMH (see Link to discussion about function and would like to optimize the execution speed of the merit function. This function accepts a 100-digit permutation and permutes a list of 100 scrabble words which have 98 lower case letters and two upper case letters and then computes the score of all possible words in the 100-letter string using a 200000 word dictionary. The upper case letters represent blank tiles and are not included in the score. Here is the complete code for the merit function (note I cannot search the dictionary with words containing upper case because if I use SameTest->(#1==ToLowerCase[#2]&) it slows down the search a ton). The example in the code has a 1092 score scrabble string and it takes about 0.12 seconds to score it on a 2.2 GHz machine. As I need to run the optimizer 100000's of times over many runs to tune it, would be nice if there is a way to make the function faster. Takes about 6 hours now for a 100000 run.

I was wondering if someone here might take a look at it and maybe make some suggestions?

Thanks, Dominic

dictionary = Import["https://norvig.com/ngrams/enable1.txt", "List"];
dictionaryMax = Max[StringLength /@ dictionary];

myScrabbleLetters = {"e", "e", "e", "e", "e", "e", "e", "e", "e", "e",
    "e", "e", "a", "a", "a", "a", "a", "a", "a", "a", "a", "i", "i", 
   "i", "i", "i", "i", "i", "i", "i", "o", "o", "o", "o", "o", "o", 
   "o", "o", "n", "n", "n", "n", "n", "n", "r", "r", "r", "r", "r", 
   "r", "t", "t", "t", "t", "t", "t", "l", "l", "l", "l", "s", "s", 
   "s", "s", "u", "u", "u", "u", "d", "d", "d", "d", "g", "g", "g", 
   "b", "b", "c", "c", "m", "m", "p", "p", "f", "f", "h", "h", "v", 
   "v", "w", "w", "y", "y", "k", "j", "x", "q", "z", "S", "S"};

permutation1092 = {65, 26, 48, 36, 66, 51, 37, 83, 86, 30, 5, 68, 47, 
   38, 77, 2, 80, 13, 96, 24, 58, 59, 14, 1, 85, 52, 28, 71, 76, 25, 
   53, 61, 90, 16, 75, 9, 50, 63, 56, 49, 27, 82, 3, 64, 55, 93, 12, 
   88, 7, 54, 78, 87, 18, 98, 17, 43, 62, 32, 57, 33, 31, 84, 19, 92, 
   8, 70, 95, 22, 40, 94, 29, 42, 73, 21, 97, 67, 20, 69, 35, 91, 39, 
   100, 23, 74, 41, 34, 46, 11, 79, 60, 15, 89, 10, 45, 6, 81, 4, 44, 
   72, 99};

pointSub = 
 Thread[Join[CharacterRange["a", "z"], CharacterRange["A", "Z"]] -> 
   Join[{1, 3, 3, 2, 1, 4, 2, 4, 1, 8, 5, 1, 3, 1, 1, 3, 10, 1, 1, 1, 
     1, 4, 4, 8, 4, 10}, ConstantArray[0, 26]]]
scoreWordList[wordlist_?ListQ] := 
  Total[Flatten@Characters@wordlist /. pointSub];



getNewScoreP2[permutation_, wordListFlag_] := 
  Module[{scrabbleLetterList, allPossibleWords, 
    possibleWordsWithUpperCase, actualWordsInLowerCase, 
    upperCaseWordsWithLowerCase, upperCaseWords, replacementRule},
   scrabbleLetterList = myScrabbleLetters[[permutation]];
   (* get all possible words including the words with upper case \
letters *)
   allPossibleWords = 
    Flatten[Table[
      StringJoin@scrabbleLetterList[[i ;; j]], {i, 
       1, (Length@scrabbleLetterList) - 1}, {j, i + 1, 
       Min[(Length@scrabbleLetterList), i + dictionaryMax]}]];
   (* next select from the possible words, 
   all that have upper case words *)
   possibleWordsWithUpperCase = 
    Select[allPossibleWords, StringCount[#, _?UpperCaseQ] > 0 &];
   (* since Dictionary has only lower case words and Intersection \
with SameTest\[Rule](ToLowerCase[#2]\[Equal]#1)&] takes too long, 
   first convert all possible words to lower case and then search \
Dictionary *)
   actualWordsInLowerCase = 
    Intersection[dictionary, ToLowerCase@allPossibleWords];
   (* now search Dictionary again to find all matches with just the \
words having upper case letters -- once again have to first convert \
to lower case to check dictionary *)
   upperCaseWordsWithLowerCase = 
    Intersection[dictionary, ToLowerCase@possibleWordsWithUpperCase];
   (* now have all valid words with upper case letters.  
   Next need to choose from the list of possible words with upper \
case letters, thoese that are valid words.  
   Also need to check for cases like  "aVes" and "aveS" and delete \
the duplicate *)
   upperCaseWords = 
    DeleteDuplicates[
     Intersection[possibleWordsWithUpperCase, 
      upperCaseWordsWithLowerCase, 
      SameTest -> (ToLowerCase[#1] == #2 &)], 
     ToLowerCase[#1] == ToLowerCase[#2] &];
   (* now have a list of valid words with upper case letters.  
   Now make rules to replace the list of valid words that have been \
selected from the Dictionary using lower case letters and convert the \
list back to upper case so can identify the blank tiles which are not \
counted. 
    *)
   replacementRule = 
    Thread[upperCaseWordsWithLowerCase -> upperCaseWords];
   (* This will produce a set of rules like:
   {"ave"\[Rule]"aVe","aves"\[Rule]"aveS","eaves"\[Rule]"eaveS",
   "es"\[Rule]"eS","rave"\[Rule]"raVe","raves"\[Rule]"raVes"}*)

   (* at this point have all valid words including the ones with \
upper case. 
   The function scoreWordList has the pointList appended to it, 
   all capital letters with score of 0 since blank tiles have zero \
score:
   {"a"\[Rule]1,"b"\[Rule]3,"c"\[Rule]3,"d"\[Rule]2,"e"\[Rule]1,
   "f"\[Rule]4,"g"\[Rule]2,"h"\[Rule]4,"i"\[Rule]1,"j"\[Rule]8,
   "k"\[Rule]5,"l"\[Rule]1,"m"\[Rule]3,"n"\[Rule]1,"o"\[Rule]1,
   "p"\[Rule]3,"q"\[Rule]10,"r"\[Rule]1,"s"\[Rule]1,"t"\[Rule]1,
   "u"\[Rule]1,"v"\[Rule]4,"w"\[Rule]4,"x"\[Rule]8,"y"\[Rule]4,
   "z"\[Rule]10,"A"\[Rule]0,"B"\[Rule]0,"C"\[Rule]0,"D"\[Rule]0,
   "E"\[Rule]0,"F"\[Rule]0,"G"\[Rule]0,"H"\[Rule]0,"I"\[Rule]0,
   "J"\[Rule]0,"K"\[Rule]0,"L"\[Rule]0,"M"\[Rule]0,"N"\[Rule]0,
   "O"\[Rule]0,"P"\[Rule]0,"Q"\[Rule]0,"R"\[Rule]0,"S"\[Rule]0,
   "T"\[Rule]0,"U"\[Rule]0,"V"\[Rule]0,"W"\[Rule]0,"X"\[Rule]0,
   "Y"\[Rule]0,"Z"\[Rule]0}
   *)
   If[wordListFlag,
    {scoreWordList@
      Replace[actualWordsInLowerCase, replacementRule, 1], 
     Replace[actualWordsInLowerCase, replacementRule, 1]}
    ,
    scoreWordList@Replace[actualWordsInLowerCase, replacementRule, 1]
    ]

   ];

AbsoluteTiming[getNewScoreP2[permutation1092, True]]
$\endgroup$
  • $\begingroup$ As for case, you could convert the whole dictionary to lower case beforehand? $\endgroup$ – lirtosiast Jul 31 at 7:36
  • $\begingroup$ Thanks. The dictionary is already in lower case. I'm just curious as to how to make this particular count function as efficient as possible. Maybe what I have is about the best we can expect. $\endgroup$ – Dominic Jul 31 at 13:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.