/*
 * 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
%* - http://sourceforge.net/project/showfiles.php?group_id=10079&package_id=9919
%* Download
%* - http://prdownloads.sourceforge.net/wordlist/agid-4.zip?download
%;

%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,'~<!?');

      if not indexc (word,'123456790.{}') then
        words.replace();

      input word @;
    end;
    input;
  end;

  words.output (dataset:'sasuser.agid_dictionary');
  stop;
run;

/**/

data
  jumbles (keep=date jumble circle)
  answers (keep=date answer)
;
input date yymmdd10. answer $char50.;
answer = scan (answer,1,'=');
output answers;
do i = 1 to 4;
  input jumble:$6. circle:$6. ;
  output jumbles;
end;
input;
format date yymmdd10.;
cards4;
2004-10-07 ---- ------
BUAQS  O--O-
CONOR  -O--O
IROING -OO--O
BLIGET OO--O-

2004-10-11 -- --- -----
ENPAC  O--O-
TAGUM  ---OO
THALIG -O-OO-
INLOPP ---OOO

2004-10-12 ---- ------
DYNOS  O--O-
SABIN  --O-O
REPTIL O--OO-
SEXOUD --OOO-

2004-10-13 -- ---- -----
LILES  O-OO-
YENDE  OO---
GOAVEY OO-O--
EFLAME -OO--O

2004-10-14 ---- ---
HANEN  --O--
GROOF  -O-O-
ROTTAH OO----
QUALEP --O-O-

2004-10-16 - -- ----
ROBAR  O----
ALTNA  -O-O-
AGCUTH O----O
BLITAR -O---O

2004-10-19 ----------
TELAH  ---OO
CLUNE  --OO-
PECILS OO---O
VESSUR -O-O-O

2004-10-20 ---- -------
SNAIE  --OOO
LEVAT  O---O
FUSULE O-OO--
MINKOO -OO-O-

2004-10-25 ---- -------
OPTIV  -O-OO
ZIRPE  OO---
DIOING O---OO
REDUSS O---OO

2004-10-27 --------
NISHY  --OO-
RETEB  -O-O-
NIANIZ --OO--
TAPECK ----OO

2004-10-31 --- ----
CHARP  ----O
TAUDI  O---O
NIRFIM O--O--
TESGAK O-O---

2004-11-01 ----- -----
BLYUL  O---O
CYDEA  O--O-
CRYLEE OO-O--
KLARET -OO--O

2004-11-03 ----- ------ = train strain
TRAIE  O--O-
TIMAD  O--OO
NARFIA -OO-O-
SPENOR --OO-O

2004-11-23 --- --- -----
HOTOT  OO-O-
HOBAR  --O-O
AMRUTE OO-O--
YONNEA -OO--O

2005-01-05 --- -----
GOBUM  --O-O
YUNNF  --O-O
RANBEN -O--O-
RUMAID --O--O

2005-07-12 ------- ----
PALLE  O-O--
CHEEN  O-OO-
THAAMS O--O-O
PECDIT OO---O

2005-07-15 --- ----
EGGOU  ----O
HYSUB  --OO-
PAMERC -O--O-
PEWDOL -O-O--

2006-05-30 --- ---
YIRNB  -O---
YOWLL  -O---
RAWDOT --O-O-
PANOWE O---O-

2006-05-31 --- --- ---
YOVEC  OO---
TOUHY  --O-O
TRUJIS ---OOO
YAIRFT O----O

2006-06-01 ---- ------
USIGE  -O-O-
GLINY  -O--O
SMUTTO -OO-O-
ANDAGE O-OO--

2006-06-09 ---- ------
COAME  --OO-
LOKEY  -O--O
NESCHO O--O-O
INNOJE O--OO-

;;;;
run;


%macro solve (date, dictionary = sasuser.bookworm_dictionary);

%local datev ;
%let datev = %sysfunc(inputn(&date,yymmdd10.));

data jumble(label="Permutations of Clues that are Words");

  declare hash dict ();
  dict.defineKey ('word');
  dict.defineDone ();

  declare hash cand ();
  cand.defineKey ('word', '_i');
  cand.defineData ('word', '_i');
  cand.defineDone ();

  length word circled $6;

  * Load the dictionary into a hash;
  do until (end_dict);
    set &dictionary (where=(length(word) between 5 and 6)) end=end_dict;
    if dict.find() eq 0 then continue;
    dict.add();
  end;

  * Load each permutation of each clue (jumbled word) into a hash;
  do until (end_jumble);
    set jumbles end=end_jumble;
    where date = &datev;
    _i + 1;
    jumble = lowcase(jumble);

    link allperm;
  end;

  put nn=;

  stop;

allperm:
  * Clues are 2 5-letter and 2 6-letter words;
  * Load the letters of a clue (jumbled word) into an array;
  array letters $1 letters1-letters6 ( 6*' ' );
  L = length (jumble);
  do i = 1 to L;
    letters[i] = substr(jumble,i);
  end;
  i = i -1;

  * Determine how many permutations the clue has;
  nperm = fact (i);

  * Load each distinct permutation that is a dictionary word into a hash;
  do i = 1 to nperm;

    * Permute the letters;
    nn + 1;
    if L = 5 then call allperm (i, of letters1-letters5); else
    if L = 6 then call allperm (i, of letters1-letters6);

    * Load the array permutation into a word;
    word = peekc (addr (letters(1)), L);

    * If the word is in the dictionary and is a new candidate
    * store it in the hash for later lookup and output it;
    if word ne jumble
       and dict.find () = 0
       and cand.find () ne 0
    then do;
      k = 1;
      circled = '';
      wurd = word;
      do j = 1 to length (circle);
        if substr(circle,j,1) = 'O' then do;
          substr(circled,k,1) = substr(word,j,1);
          substr(wurd,j,1) = upcase(substr(wurd,j,1));
          k + 1;
        end;
      end;
      put jumble= word=;
      OUTPUT;
      cand.add();
    end;
  end;
return;

  keep _i word circled circle wurd;
run;

%local answer;

* pool contains one row per combination of unjumbled words;
* if all jumbled words had only one unjumbled match, pool will have only one row;
proc sql;
  select answer into :answer from answers
  where date = &datev;

  create table pool as
  select a.circled as A
       , b.circled as B
       , c.circled as C
       , d.circled as D
       , a.wurd as _A length=6
       , b.wurd as _B length=6
       , c.wurd as _C length=6
       , d.wurd as _D length=6
  from   jumble as a
       , jumble as b
       , jumble as c
       , jumble as d
  where  a._i = 1
    and  b._i = 2
    and  c._i = 3
    and  d._i = 4
  ;
quit;

%* examine the answer guide
%* determine number of and length of each dash group
%* wordlens is used in a where IN clause
%*;

%local n maxlen wordlens len0 word;

%let n = 1;
%let len0 = 0;
%let maxlen = 0;

%do %while (%qscan(&answer,&n,%str( )) ne );

  %let word = %qscan(&answer,&n,%str( ));

  %local len&n;
  %let len&n = %length (&word);

  %let wordlens = &wordlens , &&len&n;

  %if &&len&n > &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( ))));

data _null_;

  length %do i = 1 %to &N; word&i $&&len&i %end; ;

  * hash for dictionary of words;
  declare hash dict ();
  dict.defineKey ('word');
  dict.defineDone ();

  length _1 $1;
  %do i = 2 %to %eval(&maxlen-1);
  length _&i $&i;
  * hash for dictionary of letter sequences ;
  declare hash dict&i ();
  dict&i..defineKey ("_&i");
  dict&i..defineData("_&i");
  dict&i..defineDone ();
  %end;

  %do i = 1 %to %eval(&n-1);
  * hash for word paths traversed, will be _NEW_d later;
  declare hash path&i ();
  path&i..defineKey ("_1");
  path&i..defineDone();
  %end;

  * hash for solutions;
  declare hash soln (ordered:'a');
  soln.defineKey  ( %let comma=; %do i = 1 %to &n; &comma "word&i" %let comma=,; %end; );
  soln.defineData ( %let comma=; %do i = 1 %to &n; &comma "word&i" %let comma=,; %end; , "_A", "_B", "_C", "_D");
  soln.defineDone ();

  length word $12 ;

  * populate dictionaries;

  do until (end_dict);
    set &dictionary (where=(length(word) in (-1 &wordlens))) end=end_dict;
    word = lowcase(word);

    * add word to dictionary hash;
    if dict.find() eq 0 then continue;
    dict.add();
    _ndict0+1;

    * add word parts to sub word dictionary hashes;
    %do i = 2 %to %eval(&maxlen-1);
    do i = 1 to length(word)-&i+1;
      _&i = substr(word,i,&i);
      if dict&i..find() eq 0 then continue;
      dict&i..add();
      _ndict&i + 1;
    end;
    %end;
  end;

  put (_ndict:)(=/);

  array L_0_ [&L] $1; * letter pool;
  array i_0_ [1];     * permutation indices, word 0;
  array circles [4] $6 a b c d;

  * add letters to letter pool;
  do until (end);
    set pool end=end;
    ix = 1;
    do i = 1 to dim(circles);
      do j = 1 to length (circles[i]);
        L_0_ [ix] = substr (circles[i],j,1);
        ix + 1;
      end;
    end;

    * show what is being searched;
    put _a _b _c _d '-> ' a b c d ;

    * reset path hashes;
    %do i = 1 %to %eval(&n-1);
    path&i..delete();
    path&i = _new_ hash();
    path&i..defineKey ( %let comma=; %do j = 1 %to &i; &comma "word&j" %let comma=,; %end; );
    path&i..defineDone ();
    %end;

    link w1;

    put nsc=; nsc=0;
  end;

  soln.output(dataset:"solution_&date");

  stop;

  %* create one set of nested permutation loops
  %* for each word in the answer;

%let _L = &L;
%do i = 1 %to &n;

w&i: ;

  %let im1 = %eval (&i-1);

  %let _L = %eval (&_L - &&len&im1);

  array L_&i._ [&_L] $1 ;   %* letter pool word i;
  array i_&i._ [&&len&i] ;  %* permutation indices word i;

  * populate letter pool;
  * pull all letters from prior pool not indexed by prior word ;
  j = 1;
  do i = 1 to &_L + &&len&im1;

    %* is the ith letter in prior pool claimed
    %* by a permutaion index of the prior word ?;
    do k = 1 to &&len&im1;
      if i = i_&im1._ [k] then goto skip&i;
    end;

    L_&i._ [j] = L_&im1._ [i];
    j + 1;
skip&i:
  end;

  %* create &&len&i nested loops for word i
  %* the loops iterate the permutations of &_L things taken &&len&i at a time;

  %do j = 1 %to &&len&i;
    do i_&i._&j. = 1 to &_L;

    %* next iteration if any indices repeat;
    %do k = 1 %to %eval(&j-1);
      if i_&i._&j. = i_&i._&k. then continue;
    %end;

    %* next iteration if any substring part of permutation is not in dictionary;
    %if &j < &&len&i %then %do;
      _1 = L_&i._[i_&i._&j.];
      %do k = 2 %to &j;
        %let x = %eval(&j-&k+1);
        _&k = L_&i._[i_&i._&x.] || _%eval(&k-1);

         if dict&k..find() then continue;
      %end;
    %end;
  %end;

  %let x = 1;
  word = L_&i._[i_&i._&x.]
  %do x = %eval(&x+1) %to &&len&i;
    || L_&i._[i_&i._&x.]
  %end;
  ;

  if dict.find() then continue;

  word&i = word;

  %if &i < &n %then %do;
    if path&i..find() = 0 then continue;
    path&i..add();

    link w%eval(&i+1);
  %end;
  %else %do;
    %let limit=1000;
    if soln.find() = 0 then continue;
    soln.add();
    nsc+1;
    if nsc < &limit. then put nsc word1-word&n;
    else
    if nsc = &limit. then put nsc '...';
  %end;

  %do j = 1 %to &&len&i;
    end;
  %end;

return;

%end;
run;


%mend;

options mprint;

/*
%solve (2005_07_12, dictionary=sasuser.agid_dictionary)
%solve (2005_07_15, dictionary=sasuser.agid_dictionary)
%solve (2006_05_31, dictionary=sasuser.agid_dictionary)
*/