Category: Fun
Author/Contact Info Ido Trivizki
Description: Solves rubik's cube. It does it in about 100 moves. (103 is the average.) Which is quiet a lot, I might get it lower someday.. Notice my little ugly japh commented there;) 
#!perl -w
use strict;
use Tk;
use Tk::ROText;
use Data::Dumper;
$Data::Dumper::Terse=1;

my $rmw=new MainWindow(-title=>q/Rubik's Cube Solver/);

my $mw=$rmw->Frame->pack(-side=>'left');
my $out=$rmw->Frame->pack;

my $colors=$mw->Frame->pack;
my $cubes=$mw->Frame->pack;
my $control=$mw->Frame->pack;


my($button,@colors,@radios,@sides,@steps)=0;
my $resetcolor=$mw->cget('bg');

my @cvalues=('red','white','orange','yellow','blue','green');
my @ccounts=(1)x6;
my @names=('Front','Top','Left','Right','Bottom','Back');

$colors->Label(-text=>'Select your cube colors: ',-font=>'-*-*-bold-*-
+*-*-*-260-*-*-*-*-*-*-')->grid(-row=>1,-col=>1,-columnspan=>12);
$colors->Label(-text=>'(Slice\'s color is determined by the color of i
+ts center.)')->grid(-row=>2,-col=>1,-columnspan=>12);
for my $num(0..5){
$colors->Label(-text=>"$names[$num]:")->grid(-row=>3,-col=>$num*2+1,-c
+olumnspan=>2);
push @radios,$colors->Radiobutton(-variable=>\$button,-value=>$num)->g
+rid(-row=>4,-col=>$num*2+1);
push @colors,$colors->Button(-bg=>$cvalues[$num],-activebackground=>$c
+values[$num],-width=>5,-border=>3,-command=>sub{
    if(my $new=$mw->chooseColor()){
        $cvalues[$num]=$new;
        $colors[$num]->configure(-bg=>$new,-activebackground=>$new);
        $sides[$num][1][1][0]->configure(-bg=>$new,-activebackground=>
+$new);
        for(0..5){
            for my $in (0..8){
                $sides[$_][$in/3][$in%3][0]->configure(-bg=>$new,-acti
+vebackground=>$new) if defined($sides[$_][$in/3][$in%3][1]) and $side
+s[$_][$in/3][$in%3][1]==$num;
            }
        }
    }
})->grid(-row=>4,-col=>$num*2+2);
$colors->Label(-textvar=>\$ccounts[$num])->grid(-row=>5,-col=>$num*2+2
+);
}



sub createcube{
    my($frame,$side)=(shift,shift);
    for my $m (0..8){
        $sides[$side][$m/3][$m%3][1]=$side if $m==4;
         $sides[$side][$m/3][$m%3][0]=$$frame->Button(-width=>3,$m==4?
+(-bg=>$cvalues[$side],-activebackground=>$cvalues[$side]):(-command=>
+sub{
            $sides[$side][$m/3][$m%3][0]->configure(-bg=>$cvalues[$but
+ton],-activebackground=>$cvalues[$button]);
            defined($sides[$side][$m/3][$m%3][1]) and $ccounts[$sides[
+$side][$m/3][$m%3][1]]--;
            $sides[$side][$m/3][$m%3][1]=$button;
            $ccounts[$button]++
            }))->grid(-row=>$m/3+1,-column=>$m%3+1);
    }
}

$cubes->Label(-text=>'Draw your cube: ',-font=>'-*-*-bold-*-*-*-*-260-
+*-*-*-*-*-*-')->grid(-row=>1,-col=>1,-columnspan=>4);

my $top=$cubes->Frame()->grid(-row=>2,-col=>2);
$top->Label(-text=>"Top:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-*-*-')
+->grid(-row=>1,-col=>2,-columnspan=>3);
$top->Label(-text=>'Back',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')-
+>grid(-row=>2,-col=>2,-columnspan=>3);
$top->Label(-text=>'Left',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')-
+>grid(-row=>3,-col=>1);
$top->Label(-text=>'Right',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>3,-col=>3);
$top->Label(-text=>'Front',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($top->Frame->grid(-row=>3,-col=>2)),1);

my $left=$cubes->Frame()->grid(-row=>3,-col=>1);
$left->Label(-text=>"Left:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-*-*-
+',-justify=>'left')->grid(-row=>1,-col=>2,-columnspan=>3);
$left->Label(-text=>'Top',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')-
+>grid(-row=>2,-col=>2,-columnspan=>3);
$left->Label(-text=>'Back',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>3,-col=>1);
$left->Label(-text=>'Front',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-'
+)->grid(-row=>3,-col=>3);
$left->Label(-text=>'Bottom',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($left->Frame->grid(-row=>3,-col=>2)),2);


my $front=$cubes->Frame()->grid(-row=>3,-col=>2);
$front->Label(-text=>"Front:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-*-
+*-')->grid(-row=>1,-col=>2,-columnspan=>3);
$front->Label(-text=>'Top',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>2,-col=>2,-columnspan=>3);
$front->Label(-text=>'Left',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-'
+)->grid(-row=>3,-col=>1);
$front->Label(-text=>'Right',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>3,-col=>3);
$front->Label(-text=>'Bottom',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*
+-')->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($front->Frame->grid(-row=>3,-col=>2)),0);

my $right=$cubes->Frame()->grid(-row=>3,-col=>3);
$right->Label(-text=>"Right:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-*-
+*-',-justify=>'left')->grid(-row=>1,-col=>2,-columnspan=>3);
$right->Label(-text=>'Top',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>2,-col=>2,-columnspan=>3);
$right->Label(-text=>'Front',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>3,-col=>1);
$right->Label(-text=>'Back',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-'
+)->grid(-row=>3,-col=>3);
$right->Label(-text=>'Bottom',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*
+-')->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($right->Frame->grid(-row=>3,-col=>2)),3);

my $back=$cubes->Frame()->grid(-row=>3,-col=>4);
$back->Label(-text=>"Back:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-*-*-
+')->grid(-row=>1,-col=>2,-columnspan=>3);
$back->Label(-text=>'Top',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')-
+>grid(-row=>2,-col=>2,-columnspan=>3);
$back->Label(-text=>'Right',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-'
+)->grid(-row=>3,-col=>1);
$back->Label(-text=>'Left',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-')
+->grid(-row=>3,-col=>3);
$back->Label(-text=>'Bottom',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($back->Frame->grid(-row=>3,-col=>2)),5);

my $bottom=$cubes->Frame()->grid(-row=>4,-col=>2);
$bottom->Label(-text=>"Bottom:",-font=>'-*-*-bold-*-*-*-*-200-*-*-*-*-
+*-*-',-justify=>'left')->grid(-row=>1,-col=>2,-columnspan=>3);
$bottom->Label(-text=>'Front',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*
+-')->grid(-row=>2,-col=>2,-columnspan=>3);
$bottom->Label(-text=>'Left',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>3,-col=>1);
$bottom->Label(-text=>'Right',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*
+-')->grid(-row=>3,-col=>3);
$bottom->Label(-text=>'Back',-font=>'-*-*-*-*-*-*-*-140-*-*-*-*-*-*-*-
+')->grid(-row=>4,-col=>2,-columnspan=>3);
createcube(\($bottom->Frame->grid(-row=>3,-col=>2)),4);

my $twin=$out->Scrolled('ROText',-height=>40,-width=>50,-scrollbars=>'
+oe')->pack;

$control->Button(-text=>'Solve',-command=>\&sendcube)->grid(-row=>1,-c
+ol=>1);
$control->Checkbutton(-text=>'Show Status',-variable=>\(my $showstatus
+))->grid(-row=>2,-col=>2);
my $statuscube;
$control->Button(-text=>'Show next step',-command=>sub{my $step=shift 
+@steps or return;$twin->insert('end',$$step[1]);$twin->see('end');mak
+emove($statuscube,$$step[0]);updateview($statuscube) if $showstatus})
+->grid(-row=>1,-col=>2);
$control->Button(-text=>'Show all steps',-command=>sub{$twin->insert('
+end',$$_[1]) while($_=shift @steps)})->grid(-row=>1,-col=>3);
$control->Button(-text=>'Reset',-command=>sub{for my $side(@sides){@cc
+ounts[0..5]=(1)x6;for(0..3,5..8){$$side[$_/3][$_%3][0]->configure(-bg
+=>$resetcolor,-activebackground=>$resetcolor);undef $$side[$_/3][$_%3
+][1];}}})->grid(-row=>1,-col=>4);
$control->Button(-text=>'Random Cube',-command=>sub{updateview(getrand
+cube());sendcube()})->grid(-row=>1,-col=>5);


my $deg=pack 'B*','10110000';
my %conv=(F=>'front',D=>'bottom',B=>'back',R=>'right',L=>'left',U=>'to
+p',r=>"90$deg clockwise",a=>"90$deg anticlockwise",d=>"180$deg");

sub sendcube{
    my($side,$cube)=0;
    for(['F','U'],['U','B'],['L','U'],['R','U'],['D','F'],['B','U']){
        settrans(@$_);
        my $lcube=0;
        for my $mc('FLU','FU','FRU','FL','F','FR','DFL','DF','DFR'){
            defined($sides[$side][$lcube/3][$lcube%3][1]) and $cube->{
+jss($mc)}{$$_[0]}=$sides[$side][$lcube/3][$lcube%3][1]+1;
            $lcube++;
        }
        $side++;
    }
    $statuscube=eval Dumper $cube;
    $twin->delete('1.0','end');
    (my $rc,@steps)=solve($cube);
    if($rc==0){
        $twin->insert('end',">>The input cube isn't valid. (Might be a
+ color used more or less than 9 times, or a sub-cube containing the s
+ame color twice or two opposite colors.)\n");
    }elsif($rc==-1){
        $twin->insert('end',">>The input cube isn't valid. (Probably w
+as taken apart and put together incorrectly.)\n");
    }
    $rc and $twin->insert('end','>>'.@steps." moves.\n");
    
    my $i;
    for(@steps){
        my($slice,$type)=split //;
        $_=[$_,++$i.". Turn the *$conv{$slice}* slice $conv{$type||'r'
+}.\n"];
    }
        
}

sub updateview{
    my $cube=shift;
    my $side=0;
    @ccounts[0..5]=(9)x6;
    for(['F','U'],['U','B'],['L','U'],['R','U'],['D','F'],['B','U']){
        settrans(@$_);
        my $lcube=0;
        for my $mc('FLU','FU','FRU','FL','F','FR','DFL','DF','DFR'){
            $sides[$side][$lcube/3][$lcube%3][1]=$cube->{jss($mc)}{$$_
+[0]}-1;
            $lcube++;
        }
        $side++;
    }
    for(0..5){
        for my $in (0..8){
            $sides[$_][$in/3][$in%3][0]->configure(-bg=>$cvalues[$side
+s[$_][$in/3][$in%3][1]],-activebackground=>$cvalues[$sides[$_][$in/3]
+[$in%3][1]]);
        }
    }
        
}

sub getrandcube{
    my $cube={
        FLU=>{F=>1,L=>3,U=>2},
        FU=>{F=>1,U=>2},
        FRU=>{F=>1,R=>4,U=>2},
        FL=>{F=>1,L=>3},
        F=>{F=>1},
        FR=>{F=>1,R=>4},
        DFL=>{D=>5,F=>1,L=>3},
        DF=>{D=>5,F=>1},
        DFR=>{D=>5,F=>1,R=>4},
        LU=>{L=>3,U=>2},
        U=>{U=>2},
        RU=>{R=>4,U=>2},
        L=>{L=>3},
        R=>{R=>4},
        DL=>{D=>5,L=>3},
        D=>{D=>5},
        DR=>{D=>5,R=>4},
        BLU=>{B=>6,L=>3,U=>2},
        BU=>{B=>6,U=>2},
        BRU=>{B=>6,R=>4,U=>2},
        BL=>{B=>6,L=>3},
        B=>{B=>6},
        BR=>{B=>6,R=>4},
        BDL=>{B=>6,D=>5,L=>3},
        BD=>{B=>6,D=>5},
        BDR=>{B=>6,D=>5,R=>4},
    };
    makemove($cube,$_) for map +('F','Fa','Fd','R','Ra','Rd','L','La',
+'Ld','B','Ba','Bd','U','Ua','Ud','D','Da','Dd')[rand 18],0..60;
    return $cube;
}
    

#JAPH
#my @jpah=([[0,7]],[[0,0,1,2,3,5,6,8]],[[2,0,1,3,6],[3,7,8]],[[3,0,1,2
+,3,5,6],[5,1,7]],[[2,2,5,7,8]],[[5,0,2,3,5,6,8]]);
#for(1..6){$button=$_;for(@{shift @jpah}){my $s=shift @$_;for(@$_){$si
+des[$s][$_/3][$_%3][0]->invoke()}}}

{
    my %sides=(
        F=>['U','R','D','L',{U=>0,R=>1,D=>2,L=>3},'B'],
        R=>['U','B','D','F',{U=>0,B=>1,D=>2,F=>3},'L'],
        B=>['U','L','D','R',{U=>0,L=>1,D=>2,R=>3},'F'],
        L=>['U','F','D','B',{U=>0,F=>1,D=>2,B=>3},'R'],
        U=>['B','R','F','L',{B=>0,R=>1,F=>2,L=>3},'D'],
        D=>['B','L','F','R',{B=>0,L=>1,F=>2,R=>3},'U'],
    );

    my $types={r=>1,a=>-1,d=>2};

    my($cube,%trans,@moves);

    sub makemove{
        my($cube,$side,$type)=(shift,split //,shift);
        $type=$types->{$type||'r'};
        my $copy=eval Dumper $cube;
        for my $key(grep index($_,$side)+1,keys %$cube){
            %{$cube->{join '',sort map +($side eq $_)?$_:$sides{$side}
+[($sides{$side}[4]{$_}+$type)%4],split //,$key}}=map +(/\d/ or $side 
+eq $_)?$_:$sides{$side}[($sides{$side}[4]{$_}+$type)%4],%{$copy->{$ke
+y}};
        }
    }

    sub checkvalid{
        my @colors;
        for(map values %{$cube->{$_}},keys %$cube){
        defined($_)?$colors[$_-1]++:return 0;
        }
        return 0 unless @colors==6;
        for(@colors){
            return 0 unless $_==9;
        }
        return 1;
    }

    sub settrans{    
        @trans{'F','U'}=(shift||'F',shift||'U');
        $trans{R}=$sides{$trans{F}}[($sides{$trans{F}}[4]{$trans{U}}+1
+)%4];
        @trans{'B','D','L'}=map $sides{$_}[5],@trans{'F','U','R'};
        return 1;
    }

    sub trans{
        my @totr=@_;
        s/(.)/$trans{$1}/ for @totr;
        return @totr;
    }


    sub makemoves{
    my @new=trans(@_);
    push @moves,@new;
    makemove($cube,$_) for @new;
    }

    sub findloc{
        my $wanted=join '',sort map $cube->{$_}{$_},split //,shift;
        for(keys %$cube){
            return $_ if join('',sort values %{$cube->{$_}}) == $wante
+d;
        }
    }

    sub correct{
        my $check=shift;
        for(split //,$check){
            return 0 unless $cube->{$_}{$_}==$cube->{$check}{$_};
        }
        return 1;
    }

    sub jss{
        my @ret;
        push @ret,join '',sort +trans(split//,shift) for @_;
        wantarray?@ret:$ret[0];
    }

    sub checkall{
        for(keys %$cube){
            return 0 unless correct($_);
        }
        return 1;
    }

    sub optimize{
    my $done;
    do{$done=0;
    for(my $i=1;$i<=$#moves;$i++){
        next unless substr($moves[$i],0,1) eq substr($moves[$i-1],0,1)
+;
        my($type1,$type0)=(substr($moves[$i],1,1),substr($moves[$i-1],
+1,1));
        for($type1,$type0){
            $_=$types->{$_||'r'};
        }
        if($type1+$type0==0 or $type1+$type0==4){
            splice @moves,$i-1,2;
            $done++;
        }elsif($type1==$type0){
            splice @moves,$i-1,2,substr($moves[$i],0,1).'d';
            $done++;
        }else{
            if(abs($type1)==1 and $type0==2){
                splice @moves,$i-1,2,substr($moves[$i],0,1).(undef,'a'
+,'')[$type1];
                $done++;
            }elsif($type1==2 and abs($type0)==1){
                splice @moves,$i-1,2,substr($moves[$i],0,1).(undef,'a'
+,'')[$type0];
                $done++;
            }
        }
    }}until not $done;
    }

    sub solve{
        $cube=shift;
        @moves=();
        checkvalid() or return 0;
        my %locs;

        my @topedges=(['FU','F','U'],['LU','L','U'],['RU','R','U'],['B
+U','B','U']);
        while(@topedges){
            my $loc=findloc(my $cur=$topedges[0][0]);
            $locs{join '',map "$_$cube->{$loc}{$_}",sort keys %{$cube-
+>{$loc}}}++ and return 0;
            settrans(@{$topedges[0]}[1,2]);
            if($loc eq $cur){
                unless(correct($cur)){
                    makemoves('F');
                    }else{shift @topedges;%locs=();}
            }elsif($loc eq jss('DF')){
                makemoves($cube->{$loc}{$trans{D}}==$cube->{U}{U}?'Fd'
+:'Fa')
            }elsif($loc eq jss('DR')){
                makemoves('Da')
            }elsif($loc eq jss('DL')){
                makemoves('D')
            }elsif($loc eq jss('BD')){
                makemoves('Dd')
            }elsif($loc eq jss('FR')){
                makemoves($cube->{$loc}{$trans{R}}==$cube->{U}{U}?'Fa'
+:('Ua','R','U'))
            }elsif($loc eq jss('FL')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{U}{U}?'F':
+('U','La','Ua'))
            }elsif($loc eq jss('BR')){
                makemoves($cube->{$loc}{$trans{R}}==$cube->{U}{U}?('Ud
+','B','Ud'):('Ua','Ra','U'))
            }elsif($loc eq jss('BL')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{U}{U}?('Ud
+','Ba','Ud'):('U','L','Ua'))
            }elsif($loc eq jss('BU')){
                makemoves('B')
            }elsif($loc eq jss('LU')){
                makemoves('L')
            }elsif($loc eq jss('RU')){
                makemoves('R')
            }else{return 0}
        }
        
        %locs=();
        my @topcorners=(['FRU','F','U'],['BRU','R','U'],['BLU','B','U'
+],['FLU','L','U']);
        while(@topcorners){
            {my $t;
            @topcorners=map $_->[0],sort {$a->[1] <=> $b->[1]} map [$_
+,(($t=findloc($_->[0])) eq $_->[0])?0:($t=~/D/ and $cube->{$t}{D}!=$c
+ube->{U}{U})?1:($t=~/U/)?2:3],@topcorners;
            }
            my $loc=findloc(my $cur=$topcorners[0][0]);
            $locs{join '',map "$_$cube->{$loc}{$_}",sort keys %{$cube-
+>{$loc}}}++ and return 0;
            settrans(@{$topcorners[0]}[1,2]);

            if($loc eq $cur){
                unless(correct($cur)){
                    makemoves($cube->{$cur}{$trans{R}}==$cube->{U}{U}?
+('Ra','Da','R'):('F','D','Fa'))
                }else{shift @topcorners;%locs=()}
            }elsif($loc eq jss('DFR')){
                makemoves($cube->{$loc}{$trans{F}}==$cube->{U}{U}?('F'
+,'D','Fa'):$cube->{$loc}{$trans{R}}==$cube->{U}{U}?('Ra','Da','R'):('
+Ra','Dd','R'));
            }elsif($loc eq jss('DFL')){
                makemoves($cube->{$loc}{$trans{F}}==$cube->{U}{U}?'D':
+$cube->{$loc}{$trans{L}}==$cube->{U}{U}?('Ra','D','R'):correct(jss('F
+LU'))?'D':('Fa','D','F'))
            }elsif($loc eq jss('BDR')){
                makemoves($cube->{$loc}{$trans{R}}==$cube->{U}{U}?'Da'
+:$cube->{$loc}{$trans{B}}==$cube->{U}{U}?('F','Da','Fa'):correct(jss(
+'BRU'))?'Da':('R','Da','Ra'))
            }elsif($loc eq jss('BDL')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{U}{U}?'Da'
+:$cube->{$loc}{$trans{B}}==$cube->{U}{U}?'D':correct(jss('BLU'))?'Dd'
+:('La','D','L'))
            }elsif($loc eq jss('FLU')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{U}{U}?('L'
+,'Ra','D','R','La'):('L','D','La'))
            }elsif($loc eq jss('BRU')){
                makemoves($cube->{$loc}{$trans{B}}==$cube->{U}{U}?('Ba
+','F','Da','Fa','B'):$cube->{$loc}{$trans{R}}==$cube->{U}{U}?('R','Dd
+','Ra'):('Ba','Da','B'))
            }elsif($loc eq jss('BLU')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{U}{U}?('La
+','Da','L'):$cube->{$loc}{$trans{B}}==$cube->{U}{U}?('B','D','Ba'):('
+La','Dd','L'))
            }else{return 0}
        }
        
        %locs=();
        my @middleedges=(['FR','F','U'],['BR','R','U'],['BL','B','U'],
+['FL','L','U']);
        while(@middleedges){
            {my $t;
            @middleedges=map $_->[0],sort {$a->[1] <=> $b->[1]} map [$
+_,(($t=findloc($_->[0])) eq $_->[0])?0:($t=~/D/)?1:2],@middleedges;
            }

            my $loc=findloc(my $cur=$middleedges[0][0]);
            $locs{join '',map "$_$cube->{$loc}{$_}",sort keys %{$cube-
+>{$loc}}}++ and return 0;
            settrans(@{$middleedges[0]}[1,2]);
            
            if($loc eq $cur){
                unless(correct($cur)){
                    makemoves('Ra','D','R','D','F','Da','Fa');
                }else{shift @middleedges;%locs=();}
            }elsif($loc eq jss('DR')){
                makemoves($cube->{$loc}{$trans{R}}==$cube->{$trans{F}}
+{$trans{F}}?'Dd':'D')
            }elsif($loc eq jss('DF')){
                makemoves($cube->{$loc}{$trans{F}}==$cube->{$trans{F}}
+{$trans{F}}?'Da':'Dd')
            }elsif($loc eq jss('DL')){
                makemoves($cube->{$loc}{$trans{L}}==$cube->{$trans{F}}
+{$trans{F}}?('Ra','D','R','D','F','Da','Fa'):'Da')
            }elsif($loc eq jss('BD')){
                makemoves($cube->{$loc}{$trans{B}}==$cube->{$trans{R}}
+{$trans{R}}?('F','Da','Fa','Da','Ra','D','R'):'D')
            }elsif($loc eq jss('FL')){
                makemoves('Fa','D','F','D','L','Da','La')
            }elsif($loc eq jss('BR')){
                makemoves('Ba','D','B','D','R','Da','Ra')
            }elsif($loc eq jss('BL')){
                makemoves('La','D','L','D','B','Da','Ba')
            }else{return 0}
        }

        my @down=map +(/([^D])/)[0],grep $cube->{$_}{D}==$cube->{D}{D}
+,'BD','DL','DF','DR';
        unless(@down){
            settrans('F','D');
            makemoves('B','U','L','Ua','La','Ba','U','B','L','U','La',
+'Ua','Ba');
        }elsif(@down==2){
            if($down[0] eq $sides{$down[1]}[5]){
                settrans($sides{$down[0]}[1],'D');
                makemoves('B','L','U','La','Ua','Ba');
            }else{
                my $bigger=$sides{D}[4]{$down[1]}>$sides{D}[4]{$down[0
+]};
                $bigger^=1 if $down[$bigger] eq 'R' and $down[$bigger^
+1] eq 'B';
                settrans($down[$bigger],'D');
                makemoves('B','U','L','Ua','La','Ba');
            }
        }

        my(@corr,$do,$f)=map +(/([^D])/)[0],grep correct($_),'BD','DL'
+,'DF','DR';
        if(not @corr){
                if($cube->{BD}{B}+$cube->{DF}{F}==7){
                    unless(findloc('DR')=~/$sides{(findloc('BD')=~m!([
+^D])!)[0]}[3]/){
                        settrans($cube->{BD}{B}==$cube->{R}{R}?'B':'R'
+,'D');
                        makemoves('Rd','Dd','Bd','D','Ld','Fd','Ld','F
+d','Ld','Fd','Da','Bd','Dd','Rd');
                    }else{settrans('F','D');makemoves('U') until corre
+ct('BD')}
                }else{
                    my($anycorrect,$wh)=sub{for('BD','DL','DF','DR'){r
+eturn $_ if correct($_)}};
                    settrans('F','D');
                    do{makemoves('U')} until $wh=$anycorrect->();
                    settrans($sides{($wh=~/([^D])/)[0]}[3],'D');
                    $do=1;
                }
        }elsif(@corr==2){
            if($corr[0] eq $sides{$corr[1]}[5]){
                settrans($corr[0],'D');
                makemoves('Ua','Rd','Dd','Bd','D','Ld','Fd','Ld','Fd',
+'Ld','Fd','Da','Bd','Dd','Rd');
            }else{
                my $bigger=$sides{D}[4]{$corr[1]}>$sides{D}[4]{$corr[0
+]};
                $bigger^=1 if $corr[$bigger] eq 'R' and $corr[$bigger^
+1] eq 'B';
                settrans($corr[$bigger],'D');
                makemoves('Ua');
                $do=1;
            }
        }elsif(@corr==1){
            settrans($sides{$corr[0]}[3],'D');
            $do=1;
        }
        makemoves('Rd','Da',$cube->{jss('FU')}{$trans{F}}==$cube->{$tr
+ans{B}}{$trans{B}}?('Ud','Ra','L','Fd','R','La'):('Ra','L','Fd','R','
+La','Ud'),'D','Rd') if $do;

        my @orie=grep findloc($$_[0]) eq $$_[0],['DFR'=>'R'],['DFL'=>'
+F'],['BDR'=>'B'],['BDL'=>'L'];
        if(@orie==1){
                settrans($orie[0][1],'D');
                makemoves(findloc(jss('BLU')) eq jss('FLU')?('La','U',
+'R','Ua','L','U','Ra','Ua'):('U','R','Ua','La','U','Ra','Ua','L'));
        }elsif(not @orie){
            if(findloc('DFR') eq 'BDL'){
                settrans('F','D');
                makemoves('Ra','Bd','F','R','Fa','Ra','F','R','Fa','Ra
+','F','R','Fa','Ra','Bd','R');
            }else{
                settrans(findloc('DFR') eq 'DFL'?'F':'R','D');
                makemoves('B','L','U','La','Ua','L','U','La','Ua','L',
+'U','La','Ua','Ba');
            }
        }

        settrans('F','D');
        for(0..3){
            next if $cube->{jss('FRU')}{$trans{U}}==$cube->{$trans{U}}
+{$trans{U}};
            makemoves($cube->{jss('FRU')}{$trans{F}}==$cube->{D}{D}?('
+F','D','Fa','Da','F','D','Fa','Da'):('D','F','Da','Fa','D','F','Da','
+Fa'));
        }continue{makemoves('U')}
        
        
        optimize();
        checkall() or my $rc=-1; 
        return ($rc||1,@moves);
    }
}
MainLoop;
Replies are listed 'Best First'.
Re: Rubik's Cube Solver
by Ido (Hermit) on Aug 02, 2002 at 01:38 UTC
    Thanks you all for your feedback.

    I wish podmaster and hossman were less sarcastic in their feedback, but it helped alot..

    I updated the code, here are some changes I've made:
    -Added counters of how many times each color appears.
    -Added random cube generator. (Thanks podmaster.)
    -Added a reset button. (Thanks again podmaster.)
    -Fixed the bug hossman's invalid configuration shows. (Thanks hossman.)
    -Changed the message for invalid cubes.(Thanks jsprat.)
    -Added the show status option.
[reply]
Re: Rubik's Cube Solver
by hossman (Prior) on Aug 01, 2002 at 21:46 UTC
    podmaster's comments asside, there are some invalid cube permutations that the solver evidently thinks are valid ... it just churns away trying to solve them -- presumably it will try forever (or untill the heat death of the universe, whichever comes first).

    Example... 

           W W R
       W W R
       W W R

B B B  R R W  G G G  O O O
B B B  R R W  G G G  O O O
B B B  R R W  G G G  O O O

       Y Y Y
       Y Y Y
       Y Y Y

    [download]

    I also really love the way it finds a solution to cubes with a single twist using 91 moves... that just cracks me up... 

           W W W
       W W W
       W W W

R R R  G G G  O O O  B B B
B B B  R R R  G G G  O O O
B B B  R R R  G G G  O O O

       Y Y Y
       Y Y Y
       Y Y Y

    [download]
[reply]
[d/l]
[select]

      Reminds me of 9th grade homeroom. For a brief, shining moment, obsessive geeks like myself could let it all hang out and earn the praise of fellow students.

      There were about four of us in my homeroom who could all do it in under a minute (how pubescent!). One trick was to swap two stickers before mixing up the cube and handing it to an adversary. Very nasty.

      OK, so those weren't really good days, after all; but solving the Cube first thing in the morning before an appreciative audience was still a nice way to start the day.

      BCE
      --Your punctuation skills are insufficient!

[reply]
Re: Rubik's Cube Solver
by PodMaster (Abbot) on Aug 01, 2002 at 15:51 UTC
    First, a few requests:

    How's about making sure I don't use more than 9 of a color?

    And how's about for generating a random cube?

    How's about for a reset button, so i don't have to restart the app after I mess up?

    Now I've gone through picking colors twice, and made sure i only had 9 of everything, and I still got the error about 9 color or something.

    As this looks interesting, I'd appreciate it if you could fix this, or help me with a cube configuration.

    Here is a screen shot of my cube.

    update: excuse me? Did you get this thing to do what it claims? Can you help me do the same? All I keep getting is the error shown in the image. I have abstained from voting until I get a reply from the author (i figure he can help me get it to run).

    update: Thank you jsprat. This app solves this cube in 93 moves, that's sweet. ++SixKiller.

    update: nice update SixKiller. Ovids reply makes mine sound a lot harsher than it really is. I was honestly being sincere, but whatever

    ____________________________________________________
    ** The Third rule of perl club is a statement of fact: pod is sexy.

[reply]
      podmaster, the cube shown in the screenshot is invalid. Note the orange colored squares on the top and the front. Each of these three sub-cubes has two orange sides. Also, the center blue square is opposite the center white square, but one of the blue subcubes has a white side (not possible - the centers always stay opposite each other). If you had a cube that looked like this, it would be unsolvable. Maybe the program could give a better message if the cube is invalid?

      Anyway, ++SixKiller

      Update: (link removed) Here was a solvable cube. The puzzle is created with six 180 degree turns, the script solves it in 93 moves. The next step is to test all possible combinations ;-)

      Update 2: Removed link to solvable cube

[reply]

      Yes, crazy, you can bring up all of those points, but a bit of acknowledgement of an impressive feat would have been nice. :)

      Cheers,
      Ovid

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

[reply]

Back to Code Catacombs