options nosource; /* * Richard A. DeVenezia * Oct 2004 * Oct 2005 Add comments */ dm 'clear log' log; /** / %*------------------------------------------------------------------- %* Bookworm Deluxe (www.popcap.com) has a dictionary %; data sasuser.bookworm_dictionary (label='www.popcap.com'); index = 0; length word entry $50; do until (end); infile "C:\Opt\games\pop\BookWorm Deluxe\wordlist.txt" end=end; input entry; pl = verify (entry, '0123456789'); if pl > 1 then index = input (substr(entry,1,pl-1), 4.); substr (word,index+1) = substr (entry,pl); output; end; word = 'a'; output; word = 'i'; output; keep word; run; %*------------------------------------------------------------------- %* Source forge has a couple of dictionaries %* - . %* Download %* - http://prdownloads.sourceforge.net/wordlist/agid-4.zip?download %* - extract infl.txt %; %let userdir = %sysget (USERPROFILE); data _null_; length word $25 pos $10; declare hash words (ordered:'A'); words.defineKey ('word'); words.defineData ('word'); words.defineDone (); do while (not end); infile "&userdir.\My Documents\dictionaries\infl.txt" dlm=' ,|' missover end=end; input word pos @; do until (word=''); word = compress (word,'~ &maxlen %then %let maxlen = &&len&N; %let N = %eval (&N+1); %end; %* number of words in answer; %let N = %eval (&N-1); %* number of letters in answer; %let L = %length (%sysfunc(compress(&answer,%str( )))); %put wordlens=&wordlens maxlen=&maxlen N=&N L=&L; data _null_; t0=datetime(); t00=t0; * word variable for dictionary existence via hash check(); length word prefix $&maxlen ; * answer words; length %do i = 1 %to &N; word&i $&&len&i %end; ; array words word1-word&N.; array wordlens[1:&N] (&wordlens); * hash for dictionary of words; declare hash dict (); dict.defineKey ('word'); dict.defineDone (); * hash for dictionary of word prefixes; declare hash part (); part.defineKey ("length", "count", "prefix"); part.defineDone (); * hash for solutions; declare hash soln (ordered:'a'); soln.defineKey ('combo'); soln.defineData ('combo'); do i = 1 to &N; soln.defineKey ( cats("word", i) ); soln.defineData ( cats("word", i) ); end; soln.defineData ("_A", "_B", "_C", "_D"); soln.defineDone (); * populate hashes acting as dictionaries; do until (end_dict); set &dictionary (where=(length(word) in (&wordlens))) end=end_dict; word = lowcase(word); * add word to dictionary; if dict.check() eq 0 then continue; dict.add(); _ndict+1; * add word prefixes to word prefix dictionary; length = length(word); do count = 2 to length-1; prefix = substr(word,1,count); if part.check() eq 0 then continue; part.add(); _npart + 1; end; end; put (_ndict _npart)(=/); array pool0[&L] $1; * letter pool - original; array pool [&L] $1; * letter pool - active perm; array indx [&L] ; * permutation indices; array circles [4] $6 a b c d; length np_RTL_ifs np_LTR_ifs np_swaps 8; * for each unjumbled combination; do combo = 1 by 1 until (end); set pool end=end; * add letters to letter pool; ix = 1; do i = 1 to dim(circles); do j = 1 to length (circles[i]); pool0[ix] = substr (circles[i],j,1); pool [ix] = pool0[ix]; indx [ix] = ix; ix + 1; end; end; * Show what is being searched; put / _a _b _c _d '-> ' a b c d ; nsc = 0; p = 1; * Start position of active candidate word in letter pool; q = 1; i = 2; length = wordlens[q]; * i=1 when next_perm: section reaches the final permutation * in the lexicographic sequence; * Extract word from letter pool (current permutation P); tprep + (datetime()-t0); do until (i=1); t0=datetime(); word = peekclong (addrlong (pool(p)), length); tword + (datetime()-t0); t0=datetime(); if (dict.check() ne 0) then do; tcheck_n + (datetime()-t0); t0=datetime(); * word not found, find smallest prefix not in prefix dictionary; do count = 2 to length-1; prefix = substr(word,1,count); if part.check() ne 0 then leave; end; tpref + (datetime()-t0); * Sort portion of P by descending order to reach P^; * (so next_perm advances to P*); t0=datetime(); array map[&L]; call missing (of map[*]); LEFT = p + count; RIGHT = &L; do ix = LEFT to RIGHT; map [ indx [ ix ] ] = 1; end; j = 0; do ix = 1 to &L while (LEFT + j <= RIGHT); if not map[ix] > 0 then continue; indx [ RIGHT - j ] = ix; j + 1; end; trev + (datetime()-t0); primer = min (LEFT,&L); end; else do; tcheck_a + (datetime()-t0); * word was found; words[q] = word; if (q = &N) then do; t0=datetime(); if (soln.check() ne 0) then do; * Permutation maps to a new word solution; soln.add(); nsc+1; put 'NOTE: ' nsc +2 words[*] ; * / (pool[*]) ($char3.-r) / (indx[*]) (3.); end; words[q] = ' '; tsoln + (datetime()-t0); primer = &L; end; else do; * advance p to start of next candidate word; q + 1; p + length; length = wordlens[q]; CONTINUE; * return to top of until (i=1) loop without permuting; end; end; t0=datetime(); link next_perm; tlinkout + (datetime()-t0); do while ((i <= p) and (i > 1)) ; q = q - 1; words[q]=''; length = wordlens[q]; p = p - length; end; end; put nsc= next_perms= (np:) (=); end; put / next_perms= (np:) (=); put (tprep tword tcheck_n tcheck_a tpref trev tsoln tlinkin tlinkout tseek tswap tmap) (=/); tsum = sum (tprep,tword,tcheck_n,tcheck_a,tpref,trev,tsoln,tlinkin,tlinkout,tseek,tswap,tmap); put tsum=; ttot = datetime()-t00; put ttot=; soln.output(dataset:"solution_&date"); stop; next_perm: tlinkin + (datetime()-t0); next_perms + 1; * i = &L; i = primer; t0=datetime(); do while (i > 1); if (indx[i-1] <= indx[i]) then leave; i + (-1); end; np_RTL_ifs + (primer-i+1); if i = 1 then return; j = i + 1; do while (j <= &L); if (indx[i-1] >= indx[j]) then leave; j + 1; end; np_LTR_ifs + (j-i); tseek + (datetime()-t0); t0=datetime(); * swap ; ix1 = i-1; ix2 = j-1; h = indx[ix1]; indx[ix1] = indx[ix2]; indx[ix2] = h; np_swaps + 1; * reverse v[i..n]; ix1 = i; ix2 = &L; do while (ix1 < ix2); h = indx[ix1]; indx[ix1] = indx[ix2]; indx[ix2] = h; ix1 + 1; ix2 + (-1); end; np_swaps + (ix1-i-1); tswap + (datetime()-t0); t0=datetime(); * map the portion of the items most recently permuted; if i > 1 then do ix = i-1 to dim(pool); pool [ ix ] = pool0 [ indx [ ix ] ] ; end; tmap + (datetime()-t0); t0=datetime(); return; run; %mend; options source; options mprint; /* dm log 'log;autoscroll MAX' log; %solve (2005_07_12, dictionary=sasuser.agid_dictionary) %solve (2005_07_15, dictionary=sasuser.agid_dictionary) %solve (2006_05_31, dictionary=sasuser.agid_dictionary) %solve (2005_07_12, dictionary=sasuser.agid_dictionary) */ %solve (2006_10_09, dictionary=sasuser.agid_dictionary)