Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re^4: Improve My FaceBook Scramble Solver

by Anonymous Monk
on Feb 01, 2011 at 14:57 UTC ( #885507=note: print w/ replies, xml ) Need Help??


in reply to Re^3: Improve My FaceBook Scramble Solver
in thread Improve My FaceBook Scramble Solver

Check out following code ( this removes the problem of slowing down)

#open(F,"C:\\Users\\awanchoo\\Documents\\web2.txt"); open(F,"D:\\DICT.txt"); my %dict; my %check_2; my %check_3; my %check_6; my %check_9; my %FOUND; my $startx,$starty; my $size =5; my $MAX=15; my @found_sizes; my @found_ref; while(<F>) { my $c1,$c2,$c3; #$c1=substr($_,0,1); #$c2=substr($_,1,1); #$c3=substr($_,2,1); chomp($_); #my $len=length($_); #print $_." ".$len." ".$c1.$c2.$c3."\n"; $dict{$_}="Y"; $check_2{substr($_,0,2)}=Y; $check_3{substr($_,0,3)}=Y; $check_6{substr($_,0,6)}=Y; $check_9{substr($_,0,9)}=Y; #push(dict{$c1}{$c2}{$c3}; } #foreach my $temp ( keys %full) #{ print $temp."\n"; #} while (<STDIN>) { for (my $i=0;$i<20;$i++) { $found_sizes[$i]=0; } my @arr,@bin; my $i=0,$j=0; #Reading input letters open(ip,"d:/ip.txt"); open(op,">d:/op.txt"); while(<ip>) { chomp($_); $arr[$i][0]=substr($_,0,1); $arr[$i][1]=substr($_,1,1); $arr[$i][2]=substr($_,2,1); $arr[$i][3]=substr($_,3,1); $arr[$i][4]=substr($_,4,1); $i++; #print $_." ".$i." ".$arr[$i-1][3]."\n"; } #Reset the bin reset_bin(\@bin,$size); # Start the process with each letter as starting of a string $i=0;$j=0; while($i<$size) { $j=0; while($j<$size) { $startx=$i; $starty=$j; #print " \n Starting word with $arr[$i][$j] ($i,$j) "; $bin[$i][$j]="1"; move(\@arr,$i,$j,$arr[$i][$j],\@bin); # start maing word +from arr(i,j) #print_array(\@bin,$size); $bin[$i][$j]="0";#reset_bin(\@bin,$size); $j++; } print "\n"; $i++; } foreach my $word (keys %FOUND) { my $len=length($word); $found_ref[$len]->[$found_sizes[$len]]=$word; #print "\n:".$found_ref[$len]->[$found_sizes[$len]].":".$word. +" l; $found_sizes[$len]++; } for(my $i=19;$i>=0;$i--) { print op "\n Word length $i "; for (my $j=0;$j <$found_sizes[$i];$j++) { print op "\n".$found_ref[$i]->[$j]; } } close(ip); close(op); } print %check; sub move { my $arr_ref=$_[0]; my $row=$_[1]; my $col=$_[2]; my $str=$_[3]; my $bin_ref=$_[4]; #print "\n In Move str= $str"; my $str_len=length($str); if($startx==1 && $starty==3 ) { #print "\n Word NOT found : $str $dict{$str}; ". $dict{"t +iles"}." ".$check_3{"til"}."($startx,$starty) to ($row,$col)"; } if($str_len==2 && !exists($check_2{$str})) { #print "\n Word doest exist starting with $str "; return ; # word doest exist starting with these first two +letters } if($str_len==3 && !exists($check_3{$str}) ) { #print "\n Word doest exist starting with $str "; return ; # word doest exist starting with these first thre +e letters } if($str_len==6 && !exists($check_6{$str})) { #print "\n Word doest exist starting with $str "; return ; # word doest exist starting with these first two +letters } if($str_len==9 && !exists($check_9{$str}) ) { #print "\n Word doest exist starting with $str "; return ; # word doest exist starting with these first thre +e letters } if($str_len >=3 && exists($dict{$str})) { #print "\n Word found : $str $dict{$str}; ". $dict{"tiles"}." + ".$check_3{"til"}."($startx,$starty) to ($row,$col) : $arr_ref->[$st +artx][$starty]"; $FOUND{$str}="1";#push(@FOUND,$str); # word found in dict #print_array($bin_ref,$size); } if($str_len > $MAX) { return ; } my $i=$row-1; my $j=$col-1; #print_array($bin_ref,$size); # scanning through neighbours while($i < $row+2) { #print " i=$i "; $j=$col-1; if($i >=0 && $i < $size) { while($j <$col+2) { #print " j=$j "; if($j>=0 && $j <$size) { if($bin_ref->[$i][$j]=='0') { my $temp_str; $temp_str=$str; $bin_ref->[$i][$j]="1"; $str=$str.$arr_ref->[$i][$j]; ###a +dding new elemet to string move($arr_ref,$i,$j,$str,$bin_ref) +; $bin_ref->[$i][$j]="0"; $str=$temp_str; } } $j++; } } $i++; } return 0; } sub reset_bin { $bin_ref=$_[0]; $s=$_[1]; for(my $i=0;$i<$s;$i++) { for(my $j=0;$j<$s;$j++) { $bin_ref->[$i][$j]="0"; } } } sub copy_array { $src=$_[1]; $des=$_[0]; $s=$_[2]; for(my $i=0;$i<$s;$i++) { for(my $j=0;$j<$s;$j++) { $des->[$i][$j]=$src->[$i][$j]; } } } sub print_array { print "\n Print Array : "; $arr=$_[0]; $s=$_[1]; for(my $i=0;$i<$s;$i++) { print("\n"); for(my $j=0;$j<$s;$j++) { print $arr->[$i][$j]."."; } } }


Comment on Re^4: Improve My FaceBook Scramble Solver
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://885507]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (22)
As of 2015-07-06 14:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (75 votes), past polls