HTS Permanent Programming 1: Anagram Solver

The first permanent programming challenge of HackThisSite.org was fun to work with, yet so simple with Perl. If it’s got to do with string, Perl can do it. Here is the script I used. You should of course change the path of $filename to whatever you decided to name the dictionary file.

#!/usr/local/bin/perl
my $filename = "/home/Tim/download/tmp/wordlist.txt";
my %wordlist;
my @curlist;
my $strid;
my $wrd;
my @inlist;
open( LIST,  "< " . $filename) || die "Aborting: could not open $filename\n";
foreach (<LIST>) {
	@curlist = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
	chop;
	s/\r//;
	$word = $_;
	foreach (split(//)) {
		$curlist[ord]  ;
	}
	$strid = join('', @curlist);
	$wordlist{$strid} = $word;
#	print $word . "\t" . $strid . "\n";
}
close(LIST);
print "word:";
while (<STDIN>) {
	chop;
	@inlist = ();
	foreach (split(/,/)) {
		@curlist = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
		$wrd = $_;
		foreach (split(//)) {
			$curlist[ord]  ;
		}
		$strid = join('', @curlist);
		if (exists($wordlist{$strid})) {
			print $wordlist{$strid} . "\n";
			push @inlist, $wordlist{$strid};
		} else {
			print "*** " . $wrd . ": not found\n";
			push @inlist, '-';
		}
	}
	print join(',', @inlist);
}

This script accepts a comma-separated list of words from standard input. To change that weird \n\t#-separated list you get when copy-pasting from Firefox, you can use my list conversion script that I wrote for this very mission.

Note that you could replace the wordlist with a good wordlist, and so get a working anagram solver.xxx movies full length free downloadporn movies full downloadgt dragonball moviesdumber dumb script movieerotic home moviesfarang ding dong moviesfemale ejaculation free moviesfemale monologues movie Mapbanks development loans financing ex-im leasefast loans remortgages payoutpay faxless virginia day loans inloans department education federal ofunsubsidized repayment federal stafford direct loansfederal student loans pay grants toloan advance federal home bankdallas home bank federal loan of Map

Maybe Related?

15 Comments »

  1. Hey , that is great but how good is it. Can you please show it in action anywhere on the net. I just saw a pretty good anagrammer cum word builder on the web. Will it work like this?

    Comment by anagramgeek — August 3, 2006 @ 3:03 pm

  2. Hey Im Back And Now Im Stuck With Your Perl Script - I Get This Error With My Free Web Host:
    Premature end of script headers: unscramble.cgi | (null)
    Error 500: Script Execution Failure
    Description: The server encountered an internal error or misconfiguration and was unable to complete your request.

    Comment by Tarun — March 28, 2007 @ 4:18 pm

  3. Tarun, I’m not very into CGI scripting, but I suppose that the browser expects the script to send full headers. Since this is supposed to be run on the command-line, the HTML headers are not sent. Try running it on the command-line.

    Comment by Tim — March 28, 2007 @ 6:17 pm

  4. Cool Thnx ;)

    Comment by Tarun — March 28, 2007 @ 8:18 pm

  5. were do i copy the words from the website to the script?

    Comment by wat the fuck is this all about — May 26, 2007 @ 4:42 pm

  6. wat, it’s the standard input (STDIN).

    Comment by Tim — May 30, 2007 @ 6:52 pm

  7. eh , you should make people be able to check if a string is a permutation of another, not just give them the script because they suck that much

    Comment by oh yeah — June 4, 2007 @ 2:58 am

  8. Hey, I’m d/l’ing perl just to try this, you should provide tutprdvanced prog missions. =) I’ll check back to see your response.

    +Morbid+

    Comment by Morbid — August 19, 2007 @ 3:54 am

  9. Im new to programing. if u could, it would be helpful if u give me a tutorial or guide for using Perl. I never used this program before thats y im asking. thnx-send back an email if u could help.

    Comment by Dan — September 19, 2007 @ 9:13 pm

  10. Morbid, Dan: There are lots of great Perl tutorials. Just google.

    Comment by Tim — September 23, 2007 @ 1:57 pm

  11. Hey Tim! I was the original writer of this script. But I noticed that on line 39, there is no curly bracket. What gives? it should be like this:

    #!/usr/local/bin/perl
    my $filename = “c:/wordlist.txt”;
    my %wordlist;
    my @curlist;
    my $strid;
    my $wrd;
    my @inlist;
    open( LIST, “) {
    @curlist = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
    chop;
    s/\r//;
    $word = $_;
    foreach (split(//)) {
    $curlist[ord]++;
    }
    $strid = join(”, @curlist);
    $wordlist{$strid} = $word;
    # print $word . “\t” . $strid . “\n”;
    }
    close(LIST);
    print “word:”;
    while () {
    chop;
    @inlist = ();
    foreach (split(/,/)) {
    @curlist = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
    $wrd = $_;
    foreach (split(//)) {
    $curlist[ord]++;}
    }
    $strid = join(”, @curlist);
    if (exists($wordlist{$strid})) {
    print $wordlist{$strid} . “\n”;
    push @inlist, $wordlist{$strid};
    } else {
    print “*** ” . $wrd . “: not found\n”;
    push @inlist, ‘-’;
    }
    }
    print join(’,', @inlist);

    Comment by Radical Dreamer — October 22, 2007 @ 1:45 am

  12. Programming Tutorials…

    I couldn’t understand some parts of this article, but it sounds interesting…

    Trackback by Programming Tutorials — October 23, 2007 @ 5:09 am

  13. pretty kewl - I modified it a bit to accept an argument. For my purposes (solving jumbles) it’s easier to use. I had previously found another anagram solver and it works fine too, but I’m always trying to learn a little something by looking at other techniques. I just can’t figure out what you’re doing with the @curlist array and how you’re using [ord].

    Comment by duggles — November 13, 2007 @ 6:31 pm

  14. good job on that, im pulling out my hair on #3 though(the serials one)

    Comment by slick — November 14, 2007 @ 2:42 am

  15. Here is 1 for python, took some good ideas from another site and modified it slightly:

    import string
    def anagrams(s):
    if s == “”:
    return [s]
    else:
    ans = set()
    for an in anagrams(s[1:]):
    for pos in range(len(an)+1):
    ans.add(an[:pos]+s[0]+an[pos:])
    return ans

    def dictionary(wordlist):
    dict = {}
    infile = open(wordlist, “r”)
    for line in infile:
    word = line.split(”\n”)[0]
    dict[word] = 1
    infile.close()
    return dict

    def main():
    anagram = raw_input(”Please enter words: “)
    wordLst = anagram.split(None)
    diction = dictionary(”wordlist.txt”)
    solution = “”
    for word in wordLst:
    anaLst = anagrams(word)
    for ana in anaLst:
    if diction.has_key(ana):
    diction[ana] = word
    solution += ‘%s, ‘ % (ana)
    print solution[:-2]

    main()

    Comment by Matt — January 13, 2008 @ 8:43 pm

RSS feed for comments on this post. TrackBack URI

Leave a comment

FireStats iconAnvänder FireStats