The Cat-Dog Problem

<% dim Conn dim WordRs Set Conn = Server.CreateObject("ADODB.connection") ' ConnString = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE="+Server.MapPath("../../db/Words.mdb") conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0" Conn.Open server.mappath("words.mdb") For Each ConnError in Conn.Errors Response.Write( ConnError.Description+"
") Next Set WordRs = CreateObject("ADODB.Recordset") if (UCase(Request("Submit")) = "NEW") OR (Request("Submit")="" AND Request( "NewWord" ) ="") then if Session("First")="" Then First="Cat" Session("First")=First Else First=Session("First") End if if Session("Last")="" Then Last="Dog" Session("Last")=Last Else Last=Session("Last") End if Session("FirstLength")=0 Session("LastLength")=0 Session("GotTargets")="" Session("Done")="" if Session("Message")<>"" then %>
<%=Session("Message")%> <% end if Session("Message")="" %>

The Problem:

Enter the word to start with and the one to end with:
Starting Word: Ending Word:
<% Instructions %>
Top <% else ' you already have the targets dim Prev dim NewWord 'On Error Resume Next if Session("GotTargets")="" then First = Request("First") if First <> "" then Query ="Select Word from Words WHERE Word='"+First+"'" WordRs.Open Query, Conn if WordRs.EOF=true then Session("Message")=First+" is not in the Dictionary
" end if WordRS.Close else Session("Message")="The first word cannot be blank
" end if Last = Request("Last") if Last <> "" then Query ="Select Word from Words WHERE Word='"+Last+"'" WordRs.Open Query, Conn if WordRs.EOF = true then Session("Message")=Session("Message")+Last+" is not in the Dictionary
" end if else Session("Message")=Session("Message")+"The last word cannot be blank
" end if WordRS.Close if Len(First)<>Len(Last) Then Session("Message")=Session("Message")+"The two target words must be the same length" elseif UCase(First)=UCase(Last) Then Session("Message")=Session("Message")+"The two target words should not be the same" end if Session("First") = First Session("Last") = Last if Session("Message")<>"" then Response.Redirect( "catdog.asp" ) else Session("GotTargets")="True" end if end if First = Session("First") Last = Session("Last") if Request("Submit")="Undo one from Start" then if Session("FirstLength") > 0 then Session.Contents.Remove("First"+CStr(Session("FirstLength"))) Session("FirstLength") = Session("FirstLength")-1 end if elseif Request("Submit")="Undo one from End" then if Session("LastLength") > 0 then Session.Contents.Remove("Last"+CStr(Session("LastLength"))) Session("LastLength") = Session("LastLength")-1 end if elseif Request("NewWord") <>"" Then NewWord = Request("NewWord") Query ="Select Word from Words WHERE Word='"+NewWord+"'" WordRs.Open Query, Conn if WordRs.EOF=true then Session("Message")=NewWord+" is not in the Dictionary
" end if if Session("Message")="" then if Len(NewWord)<>Len(First) then Session("Message")="The new word must be the same length as the first word
" end if end if if Session("Message")="" then 'the word is good (we know add or enter was pressed) if Session("FirstLength")>0 then Field ="First"+CStr(Session("FirstLength")) Prev = Session(Field) else 'Response.Write("Nothing in first") Prev = First end if Prev1=UCase(Prev) NewWord1=UCase(NewWord) if Legal(NewWord,Prev) then if UCase(NewWord) <> UCase(Prev) then Session("FirstLength")=Session("FirstLength")+1 Field="First"+Cstr(Session("FirstLength")) Session(Field)=NewWord end if else if Session("LastLength")>0 then Field ="Last"+CStr(Session("LastLength")) PrevL = Session(Field) else PrevL = Last end if PrevL1=UCase(PrevL) if Legal(NewWord1,PrevL1) then if UCase(NewWord) <> UCase(PrevL) then Session("LastLength")=Session("LastLength")+1 Field="Last"+Cstr(Session("LastLength")) Session(Field)=NewWord end if else Session("Message")=NewWord+" does is not a valid change from either "+Prev+ " or "+PrevL end if end if end if 'got a good new word if Session("Message")="" And (Session("FirstLength")>0 OR Session("LastLength")>0) then F1="First"+CStr(Session("FirstLength")) F2="Last"+CStr(Session("LastLength")) if UCase(Last)=UCase(Session(F1)) OR UCase(First)=UCase(Session(F2)) OR UCase(Session(F1))=UCase(Session(F2)) Then Session("Message") ="Great, you have solved the problem!
" Session("Done")="TRUE" end if end if WordRS.Close end if ' new is not blank %> Instructions <% if Session("Message")<>"" then %>
<%=Session("Message")%> <% end if Session("Message")="" %>
> <% for i = 1 to Session( "FirstLength") Field = "First"+CStr(i) %> <% next if Session("Done")="" then %> <% next %>
Start <%=First%>
New Word: > <% end if for i = Session( "LastLength") to 1 Step -1 Field = "Last"+Cstr(i) %>

Top <% Instructions end if %> <% Function Legal( First1, Last1) First2=UCase(First1) Last2=UCase(Last1) if Len(First2)=0 then Legal = "false" else 'Response.Write("Legal") Diff = 0 for i = 1 to Len(First2) if Mid(First2,i,1) <> Mid(Last2,i,1) then Diff = Diff+1 end if next 'Response.Write(Diff) if Diff < 2 and Len(First1)>0 then Legal = "True" else Legal = "false" end if end if End Function Sub Instructions() %>


This is the Cat-Dog problem:

Change the word Cat into the word Dog following these rules:

1. Change the words one letter at a time in place. For example you can change Cat to Can or to Hat.
2. You can't rearrange letters in one turn. This is NOT legal: Changing Dog to God or Cat to Act or to Ace.
3. Each step must be a real word. You can make Cat into Cap but not into Cet.

This calculator will allow you to keep track of your changes and enforce the rules.

You may work your way from either end of the problem or both.
You can try to change other words besides cat and dog. They can be any size, but both must be the same length and both must be real words.
For example, try changing Beef to Lamb.

How the program works
First type the starting and ending words in the boxes and click on "Submit".
Now type your new words in the "New Word" box.
Then you make two chains of words, one starting from the beginning word,
one starting from the ending word.
You can add your word to the list by clicking "Add". The program will add it to the correct chain
When the two chains meet you are done.
You can back up one step in either chain by clicking on "Undo One from Start" and "Undo One from End"
Have Fun.
(This program uses the 2of12 word list, which is available on the web at
<% End Sub %>