topic Another word game in SAS Programming

Another word game

FriedEgg — Wed, 14 Sep 2011 21:52:45 GMT

Hi,

I have been working on my knowledge of hash tables and to train myself I usually like to find/create puzzles. I was thinking of something to do and I remembered a word puzzle that was created by the author of Alice and Wonderland. It is called a word ladder.

The basic concept (from the wiki page linked above):

Take two words with the same length, for instance: COLD, WARM and find the list of words that easily transform with the alteration of a single letter for form the new word.

COLD->WARM

COLD

cord

card

ward

WARM

In a situation where a connection cannot be found in the version I remember you can scramble the letters from the last word in your ladder to form a new word and continue from that point. As an example:

COLD->DRAW

COLD

cord

card

ward

DRAW* note that this is just an example and there is probably a way to make this connection without the scramble.

Typically the words used to for a ladder are antonyms in my experience so I challege you to create a program that can solve a ladder from BLACK->WHITE

Have fun!

P.S. I have attached a copy of the unix word dictionary to help along the way.

Another word game

Ksharp — Fri, 16 Sep 2011 08:35:46 GMT

OK .Alice and Wonderland . I am coming.

But for your dictionary can not find a route from black to white.

But I found a way from cold to warm.See the following code.

data temp;
 infile 'c:\unix-words';
 input key : $100.;
 if length(key) eq 4 then output;
run; 
%let start=cold;
%let end=warm;
data want;
 key="&start";
run;

%macro sub(count=);
%if  %sysfunc(mod(&count,4))=1 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4) as _key
%end;
%else %if %sysfunc(mod(&count,4))=2 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if  %sysfunc(mod(&count,4))=3 %then %do;
"_"||substr(&_key,2)  as _key
%end;
%else %if  %sysfunc(mod(&count,4))=0 %then %do;
substr(&_key,1,3)||"_" as _key
%end;


%mend sub;

%macro Alice;
proc sql;


%let up= ;
%let an=;
%let j=;
%let _key=key&j;
%let i=1;
%let down=key as key&i;


%do %until(&flag=Y);
%let flag=N;
create table _temp as
 select &up.%sub(count=&i)
  from want;
create table want as
 select &down
  from temp,_temp
   where key like strip(_key) &an ;


select * from want where key&i = "&end";

%if &sqlobs ge 1 %then %do; %let flag=Y ;%end;

%let up=&up.key&i., ;
%let an=and key ne key&i;
%let j=%eval(&j+1);
%let _key=key&j;
%let i=%eval(&i+1);
%let down=&up.key as key&i;

%end;


quit;
%mend Alice;
options mprint mlogic symbolgen;
%Alice

Ksharp

Another word game

Ksharp — Fri, 16 Sep 2011 08:37:11 GMT

The following code is for your question.

data temp;
 infile 'c:\unix-words';
 input key : $100.;
 if length(key) eq 5 then output;
run; 
%let start=black;
%let end=white;
data want;
 key="&start";
run;

%macro sub(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
"_"||substr(&_key,2) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
substr(&_key,1,4)||"_" as _key
%end;


%mend sub;

%macro Alice;
proc sql;

%let up= ;
%let an=;
%let j=;
%let _key=key&j;
%let i=1;
%let down=key as key&i;


%do %until(&flag=Y);
%let flag=N;
create table _temp as
 select &up.%sub(count=&i)
  from want;
create table want as
 select &down
  from temp,_temp
   where key like strip(_key) &an ;


select * from want where key&i = "&end";

%if &sqlobs ge 1 %then %do; %let flag=Y ;%end;

%let up=&up.key&i., ;
%let an=and key ne key&i;
%let j=%eval(&j+1);
%let _key=key&j;
%let i=%eval(&i+1);
%let down=&up.key as key&i;

%end;


quit;
%mend Alice;
options mprint mlogic symbolgen;
%Alice

Ksharp

Another word game

FriedEgg — Fri, 16 Sep 2011 20:40:16 GMT

The link does indeed exist in the dictionary file provided, I manually checked all the words, if you would like I will give you the answer to the ladder to help debug. There are 6 words in the chain. There is also another linkage that takes 9 steps.

Another word game

FriedEgg — Fri, 16 Sep 2011 20:53:27 GMT

I was replying to your original posting while you posted a working solution. It finds a version in 15 steps. Can it be optimized to find shortest ladder?

Another word game

Ksharp — Sat, 17 Sep 2011 03:21:28 GMT

I test it anyway by my hand, there is not a ladder. for black -> white.

Do you change the letter only at the first position before current letter .

black -> blank

only change the first letter before k (i.e. c) one time,not change any one of b , l , a ?

Another word game

Ksharp — Sat, 17 Sep 2011 03:22:47 GMT

data temp;
 infile 'c:\unix-words';
 input key : $100.;
 if length(key) eq 5 then output;
run; 
%let start=black;
%let end=white;


%macro sub1(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
substr(&_key,1,4)||"_" as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
"_"||substr(&_key,2) as _key
%end;
%mend sub1;

%macro sub2(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
"_"||substr(&_key,2) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
substr(&_key,1,4)||"_" as _key
%end;
%mend sub2;

%macro sub3(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
"_"||substr(&_key,2) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
substr(&_key,1,4)||"_" as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%mend sub3;

%macro sub4(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
"_"||substr(&_key,2) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
substr(&_key,1,4)||"_" as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%mend sub4;


%macro sub5(count=);
%if  %sysfunc(mod(&count,5))=1 %then %do;
"_"||substr(&_key,2) as _key
%end;
%else %if %sysfunc(mod(&count,5))=2 %then %do;
substr(&_key,1,4)||"_" as _key
%end;
%else %if  %sysfunc(mod(&count,5))=3 %then %do;
substr(&_key,1,3)||"_"||substr(&_key,5) as _key
%end;
%else %if  %sysfunc(mod(&count,5))=4 %then %do;
substr(&_key,1,2)||"_"||substr(&_key,4)  as _key
%end;
%else %if  %sysfunc(mod(&count,5))=0 %then %do;
substr(&_key,1,1)||"_"||substr(&_key,3)  as _key
%end;
%mend sub5;


%macro Alice;
proc sql;

%do k=1 %to 1;
create table want (key char(40));
insert into want values("&start");
%let up= ;
%let an=;
%let j=;
%let _key=key&j;
%let i=1;
%let down=key as key&i;

%do x=1 %to 20;
create table _temp as
 select &up.%sub5(count=&i)
  from want;
create table want as
 select &down
  from temp,_temp
   where key like strip(_key) &an ;


select * from want where key&i = "&end";

%if &sqlobs ge 1 %then %do; %put WARNING: Found at  iteration for key&i ; %abort;%end;

%let up=&up.key&i., ;
%let an=and key ne key&i;
%let j=%eval(&j+1);
%let _key=key&j;
%let i=%eval(&i+1);
%let down=&up.key as key&i;

%end;
%end;


quit;
%mend Alice;
options mprint mlogic symbolgen;
%Alice

Ksharp

Another word game

FriedEgg — Sat, 17 Sep 2011 07:20:36 GMT

The rule is to change only one letter per step in the ladder, it can be any letter though.

BLACK

blank

blink

clink

chink

chine

whine

WHITE

This is the shortest version of the ladder I can find.

It is not a simple task, for sure.

Another word game

Ksharp — Sat, 17 Sep 2011 11:40:45 GMT

You do not change a letter step by step forward, you do skip forward, that is also included into rule?

But I will think about it.

Another word game

Ksharp — Mon, 19 Sep 2011 10:19:21 GMT

FriedEgg

As your logic, it is not ladder forward but forward and backward.

I found another way almost like yours.

BLACK

blank

clank

clink

chink

chine

whine

WHITE

I know i should make a macro for this, But I think you can do it by yourself.

The following is very crude code.

data temp;
 infile 'c:\unix-words';
 input key : $100.;
 if length(key) eq 5 then output;
run;
%let start=black;
%let end=white;
data dict(drop=i key);
 set temp;
 array a{*} $ 1 a1-a5;
 do i=1 to dim(a);
  a{i}=substr(key,i,1);
 end;
run;
data temp(drop=i);
array a{*} $ 1 _a1-_a5;
 do i=1 to dim(a);
  a{i}=substr("&start",i,1);
 end;
run;
data want(keep=a:);
 set dict;
 if _n_ =1 then set temp;
 if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5);
run;
data want1;
   set dict;
do i=1 to _nobs;
set want(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;
proc sort data=want1 nodupkey;
 by _all_;
run;

data want2;
   set dict;
do i=1 to _nobs;
set want1(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;

proc sort data=want2 nodupkey;
 by _all_;
run;
data want3;
   set dict;
do i=1 to _nobs;
set want2(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;
proc sort data=want3 nodupkey;
 by _all_;
run;
data want4;
   set dict;
do i=1 to _nobs;
set want3(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;
proc sort data=want4 nodupkey;
 by _all_;
run;
data want5;
   set dict;
do i=1 to _nobs;
set want4(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;
proc sort data=want5 nodupkey;
 by _all_;
run;
data want6;
   set dict;
do i=1 to _nobs;
set want5(keep=a: rename=(a1=_a1 a2=_a2 a3=_a3 a4=_a4 a5=_a5)) nobs=_nobs point=i;
if    (a2=_a2 and a3=_a3 and a4=_a4 and a5=_a5 and a1 ne _a1) or
     (a1=_a1 and a3=_a3 and a4=_a4 and a5=_a5 and a2 ne _a2) or
     (a1=_a1 and a2=_a2 and a4=_a4 and a5=_a5 and a3 ne _a3) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a5=_a5 and a4 ne _a4) or
     (a1=_a1 and a2=_a2 and a3=_a3 and a4=_a4 and a5 ne _a5) then output;
end;
run;
proc sort data=want6 nodupkey;
 by _all_;
run;
















data  want5;set  want5(rename=(_a1-_a5=__a1 - __a5  ));run;
data  want5;set  want5(rename=(  a1-a5=_a1-_a5  ));run;
proc sort data=want6 out=result;
 by _:;
run;
data result;
 merge result want5;
 by _a1 - _a5;
run;

data  want4;set  want4(rename=(_a1-_a5=___a1 - ___a5  ));run;
data  want4;set  want4(rename=(  a1-a5=__a1-__a5  ));run;
proc sort data=result;
 by __:;
run;
data result;
 merge result want4;
 by __a1 - __a5;
run;

data  want3;set  want3(rename=(_a1-_a5=____a1 - ____a5  ));run;
data  want3;set  want3(rename=(  a1-a5=___a1-___a5  ));run;
proc sort data=result;
 by ___:;
run;
data result;
 merge result want3;
 by ___a1 - ___a5;
run;

data  want2;set  want2(rename=(_a1-_a5=_____a1 - _____a5  ));run;
data  want2;set  want2(rename=(  a1-a5=____a1-____a5  ));run;
proc sort data=result;
 by ____:;
run;
data result;
 merge result want2;
 by ____a1 - ____a5;
run;

data  want1;set  want1(rename=(_a1-_a5=______a1 - ______a5  ));run;
data  want1;set  want1(rename=(  a1-a5=_____a1-_____a5  ));run;
proc sort data=result;
 by _____:;
run;
data result;
 merge result want1;
 by _____a1 - _____a5;
run;

data final_result(keep=word:);
 set result;
 word1=cats(of a:);
 word2=cats(of _a:);
 word3=cats(of __a:);
 word4=cats(of ___a:);
 word5=cats(of ____a:);
 word6=cats(of _____a:);
 word7=cats(of ______a:);
 if word1="&end";
run;

Ksharp

Another word game

FriedEgg — Mon, 19 Sep 2011 21:20:02 GMT

I did not thoroughly check my code but this is what I had come up with. Very similar to KSharp's approach. I am going to take some time later and convert this to using hash objects as that is the ultimate personal goal of the challenge for myself. I am fairly certain that my example with only find odd number length ladders since I am approaching from both sides to save time with the size of the cartesian joins, which is obviously a problem to also fix.

options fullstimer spool macrogen mlogic mprint;

%let from=black;

%let to=white;

data _null_;

/* rule 1: the from and to words must be the same length */

if length("&from") ne length("&to") then

do;

put 'ERROR: FROM AND TO MUST BE SAME LENGTH';

abort return;

end;

else

do;

call symput("len",length("&from"));

call symput("from",%upcase("&from"));

call symput("to",%upcase("&to"));

end;

run;

data dict;

infile '/usr/share/dict/words';

input word :$upcase40.;

if length(word)=&len and word=compress(word,,'ka') then output;

run;

proc sort data=dict nodupkey; by word; run;

/* streaminit */

data step1;

length start $40;

set dict;

where complev("&from",word,'i')=1;

start="&from";

run;

data _step1;

length end $40;

set dict;

where complev("&to",word,'i')=1;

end="&to";

run;

/* loop */

%macro ladder;

%let done=N;

%let i=1;

%do %until (&done=Y);

%let n=%eval(&i+1);

data step&n;

set dict;

do i=1 to _nobs;

set step&i(rename=(word=step&i)) nobs=_nobs point=i;

if complev(step&i,word)=1 and word ne start %if &i>1 %then %do j=1 %to %eval(&i-1); and word ne step&j %end; then output;

end;

run;

data _step&n;

set dict;

do i=1 to _nobs;

set _step&i(rename=(word=_step&i)) nobs=_nobs point=i;

if complev(_step&i,word)=1 and word ne end %if &i>1 %then %do j=1 %to %eval(&i-1); and word ne _step&j %end; then output;

end;

run;

/* FIX: probably want to better name variables so order can be recognized */

/* start -> step1 -> stepn -> word -> _stepn -> _step1 -> end */

data want;

merge step&n(in=b) _step&n(in=a);

by word;

if a and b;

run;

proc sql noprint;

select nobs into :nobs

from sashelp.vtable

where libname='WORK' and memname='WANT';

quit;

%let i=%eval(&i+1);

%if &nobs>0 %then %let done=Y;

%end;

%mend;

%ladder

This code was able to find solution in 5 ladder steps. The solution I had posted earlier as the example solution I had solved manually.

BLACK

1. brack

2. brace

3. brice

4. brite

5. write

WHITE

Another word game

Ksharp — Wed, 21 Sep 2011 07:44:16 GMT

But. FriedEgg

in the dictionary ( I used is the last post you gave me -------- a word game).

There is not word " brack".

So how can you change black into brack?

Ksharp

Another word game

FriedEgg — Wed, 21 Sep 2011 18:20:44 GMT

I downloaded that dictionary from the internet, it claimed to be a distributable copy of the unix dictionary file but I guess it is not identical. I am using dictionary file that is built into my OS and I guess it is slightly different. I changed to use the same file and also fixed the issue with my program only finding solutions in odd number of steps in length.

options fullstimer mlogic mprint;

%let from=black;

%let to=white;

data _null_;

if length("&from") ne length("&to") then

do;

put 'ERROR: FROM AND TO MUST BE SAME LENGTH';

abort return;

end;

else if complev("&from","&to",'i')=1 then

do;

put 'ERROR: FROM AND TO ARE ALREADY 1 STEP APART';

abort return;

end;

else

do;

call symput("len",length("&from"));

call symput("from",%upcase("&from"));

call symput("to",%upcase("&to"));

end;

run;

data dict;

infile '/nas/sasbox/users/mkastin/unix-words';

input word :$upcase40.;

if length(word)=&len and word=compress(word,,'ka') then output;

run;

proc sort data=dict nodupkey; by word; run;

data step1;

length start $40;

set dict;

where complev("&from",word,'i')=1;

start="&from";

run;

data _step1;

length end $40;

set dict;

where complev("&to",word,'i')=1;

end="&to";

run;

/* loop */

%macro solve(in1,in2);

data want;

merge &in1(in=b) &in2(in=a);

by word;

if a and b;

run;

proc sql noprint;

select nobs into :nobs

from sashelp.vtable

where libname='WORK' and memname='WANT';

quit;

%if &nobs>0 %then %let done=Y;

%mend;

%macro ladder;

%let done=N;

%let i=1;

%do %until (&done=Y);

%let n=%eval(&i+1);

data step&n;

set dict;

do i=1 to _nobs;

set step&i(rename=(word=step&i)) nobs=_nobs point=i;

if complev(step&i,word)=1 and word ne start %if &i>1 %then %do j=1 %to %eval(&i-1); and word ne step&j %end; then output;

end;

run;

%solve(_step&i,step&n);

%if &done=Y %then %goto exit;

data _step&n;

set dict;

do i=1 to _nobs;

set _step&i(rename=(word=_step&i)) nobs=_nobs point=i;

if complev(_step&i,word)=1 and word ne end %if &i>1 %then %do j=1 %to %eval(&i-1); and word ne _step&j %end; then output;

end;

run;

%solve(step&n,_step&n)

%let i=%eval(&i+1);

%exit:

%end;

%mend;

%ladder

BLACK

1. blank

2. blink or clank

3. clink

4. chink

5. chine

6. whine

WHITE

1. whine

2. chine

3. chink

4. chick

5. check

6. cheek

7. creek

8. greek

GREEN

Another word game

DF — Fri, 23 Sep 2011 22:45:53 GMT

This isn't the tidiest code, but it's a brute-force method of finding all solutions within a given number of steps.

On my PC it takes about 6 minutes to run end to end, and produces 286 solutions to a maximum of 10 steps. Obviously adding additional steps will exponentially increase the running time, although I'm sure there's room for some efficiency.

I originally wrote the comparison of words by using a series of SQL like statements (e.g. like '%lack' or like 'b%ack' or like 'bl%ck' etc.), but after reading your code I realised I'd forgotten complev, which reduced the overall running time by about 60%.

data _null_;

datetime = put(datetime(),datetime20.);

putlog datetime=;

run;

%let start=black;

%let end=white;

%put &start.;

%put &end.;

data words;

infile 'c:\unix-words';

format word $100.;

input word $;

if length(word) = length("&start.") then output;

run;

%macro wordchain();

%let max_links = 10;

proc sql;

create table wordchain_1 as

select

0 as found,

words.word as word_1

from

words

where

words.word = "&start.";

quit;

%do i = 2 %to &max_links;

%put &i.;

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

%put &j.;

proc sql;

create table wordchain_&i. as

select

(wordchain_&j..found or words.word = "&end.") as found,

wordchain_&j..*,

words.word as word_&i.

from

wordchain_&j.

left join words on

(

complev(wordchain_&j..word_&j.,words.word,"il") = 1

)

and

(

%do n = 1 %to &j.;

%if &n > 1 %then and;

words.word ~= wordchain_&j..word_&n.

%end;

)

and wordchain_&j..word_&j. ~= "&end."

/* and length(words.word) = length("&end.")*/

where

calculated found

or (not (calculated found) and words.word is not missing)

;

quit;

%end;

%leave:;

%mend;

%wordchain();

data solutions;

set wordchain_10;

where found = 1;

array words{*} word_1-word_10;

count = 0;

do i = 1 to dim(words);

if missing(words{i}) then leave;

count = count + 1;

end;

drop i;

run;

proc sort data=solutions;

by count;

run;

data _null_;

datetime = put(datetime(),datetime20.);

putlog datetime=;

run;

Another word game

DF — Sat, 24 Sep 2011 11:51:43 GMT

Bit of an improvement on the previous version. This takes about 10 seconds to run on my PC, again for 10 steps.

Changes were:

reduce the format length stored down from 100, to whatever is required to store the current words
add complev's limiter at 2 (i.e. stops counting the difference once it hits 2).

That got me about 50% saving.

I then realised I could calculate all permutations of X-letter words prior to the looping, which pretty much trivialised the running time.

data _null_;

datetime = put(datetime(),datetime20.);

putlog datetime=;

run;

%let start=black;

%let end=white;

%let max_links = 10;

%put &start.;

%put &end.;

%put &max_links.;

data words;

infile 'c:\unix-words';

format word $22.;

input word $;

if length(word) = length("&start.") then output;

run;

data words;

format word $%length(&start.).;

set words;

run;

proc sql;

create table wordlinks as

select

monotonic() as n format 8.,

words.word as old_word,

words2.word as new_word

from

words,

words as words2

where

complev(words.word,words2.word,2,"il") = 1;

quit;

%macro wordchain();

proc sql;

create table wordchain_1 as

select

0 as found,

words.word as word_1

from

words

where

words.word = "&start.";

quit;

%do i = 2 %to &max_links;

%put &i.;

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

%put &j.;

proc sql;

create table wordchain_&i. as

select

(wordchain_&j..found or wordlinks.new_word = "&end.") as found,

wordchain_&j..*,

wordlinks.new_word as word_&i.

from

wordchain_&j.

left join wordlinks on

(

wordchain_&j..word_&j = wordlinks.old_word

)

and

(

%do n = 1 %to &j.;

%if &n > 1 %then and;

wordlinks.new_word ~= wordchain_&j..word_&n.

%end;

)

and wordchain_&j..word_&j. ~= "&end."

/* and length(words.word) = length("&end.")*/

where

calculated found

or (not (calculated found) and wordlinks.old_word is not missing)

;

quit;

%end;

%leave:;

%mend;

%wordchain();

data solutions;

set wordchain_&max_links.;

where found = 1;

array words{*} word_1-word_&max_links.;

count = 0;

do i = 1 to dim(words);

if missing(words{i}) then leave;

count = count + 1;

end;

drop i;

run;

proc sort data=solutions;

by count;

run;

data _null_;

datetime = put(datetime(),datetime20.);

putlog datetime=;

run;