Take solutions from Shuang Chen's 4x4x4 solver, "optimize" the reduction part for BTM by replacing consecutive moves on the same axis with as few equivalent moves as possible, and produce input files for Cube Explorer for optimizing the 3x3x3 part. It's messy, inefficient and possibly buggy, sorry, I'm a bit out of shape and didn't have much tim…

BTMize_ChenSolutions.pl

use v5.10;

sub invertMove {
  my ($m) = @_;
  return $m if $m =~ /2$/;
  return "$m'" if $m !~ /'/;
  $m =~ s/'//;
  return $m;
}

sub invertAlg {
  my ($moves) = @_;
  $moves = join ' ', map {invertMove($_)} reverse split / /, $moves;
  return $moves;
}

sub onlyCLockwiseQuarterTurns {
  my ($moves) = @_;
  $moves =~ s/(\S+)2\b/$1 $1/g;
  $moves =~ s/(\S+)'/$1 $1 $1/g;
  return $moves;
}

# Turn a string like "Fw2 B' S F B2 2F2 z'" into a number so that such strings get the same number iff their effect on the cube is the same.
sub hash {
  my ($axisMoves) = @_;
  
  # Most important distinction in the hash will be the axis.
  my $hash = 0;
  $hash = 10000 if $axisMoves =~ /[LMRx]/;
  $hash = 20000 if $axisMoves =~ /[FSBz]/;

  # Normalize to FSBz-axis clockwise quarter turns
  $axisMoves = onlyCLockwiseQuarterTurns($axisMoves);
  $axisMoves =~ y/LMRDEU/FSBFSB/;
  $axisMoves =~ s/([xy])/z'/g;
  $axisMoves = onlyCLockwiseQuarterTurns($axisMoves);
  
  my %effects = ('F' => 1, '2F' => 10, '2B' => 300, 'B' => 3000, 'Fw' => 11, 'S' => 110, 'Bw' => 3300, 'z' => 1111);
  for my $m (split / /, $axisMoves) {
    $hash += $effects{$m};
    #say $m, $hash;
    $hash =~ y/456/012/;
  }
  
  return $hash;
}

#say hash('F');
#say hash("Fw2 B' S F B2 2F2 z'");
#exit();

# $bestAxisMoves{$axisMoves} shall become a BTM-optimal reduction of $axisMoves
unless (-f "BTM_BestAxisMoves.txt") {

  # Compute @bestAxisMoves
  @bestAxisMoves = ();
  for my $options (("F B S z Fw Bw 2F 2B", "L R M x Lw Rw 2L 2R", "D U E y Dw Uw 2D 2U")) {
    my @options = split / /, $options;
    for my $i (1 .. 4**8) {
      @moves = ();
      for my $j (0 .. 7) {
        my $move = $options[$j];
        my $n = ("", $move, $move."2", $move."'")[($i >> (2*$j)) & 3];
        unshift @moves, "$n" if $n; 
      }
      my $axisMoves = "@moves";
      my $hash = hash($axisMoves);
      #say "  $axisMoves" if $hash == 10021 and BTM($axisMoves) <= 2;
      $bestAxisMoves[$hash] = $axisMoves unless $bestAxisMoves[$hash] and BTM($bestAxisMoves[$hash]) <= BTM($axisMoves);
      if (++$ctr1 % 10000 == 0) {
        say BTM($axisMoves), " ", $axisMoves;
      }
    }
    #say $bestAxisMoves[hash("Fw2 B' S F B2 2F2 z'")];
  }

  # Store @bestAxisMoves to file
  open my $fh, '>', "BTM_BestAxisMoves.txt";
  print $fh "$_\n" foreach @bestAxisMoves;
  close $fh;
}

open my $fh, '<', "BTM_BestAxisMoves.txt";
@bestAxisMoves = map { chomp; $_ } <$fh>;
close $fh;

#say $bestAxisMoves[hash("Fw2 B' S F B2 2F2 z'")];
#say $bestAxisMoves[hash("F2 B2")];
#exit;

# Removes the cube rotations from a move sequence string, adapting the moves as necessary.
sub removeRotations {
  my ($alg) = @_;

  $alg =~ s/  +/ /g;
  $alg =~ s/^ | $//g;

  # Reduce to clockwise quarter rotations.
  $alg =~ s/([xyz])2/$1 $1/g;
  $alg =~ s/([xyz])\'/$1 $1 $1/g;
  
  # Remove the last rotation as long as there are any left.
  while (my ($pre, $rot, $post) = ($alg =~ /(.*)([xyz])([^xyz]*)/)) {
  
    # Adapt the moves after the rotation.
    $post =~ y/FUBD/DFUB/ if $rot eq 'x';
    $post =~ y/FLBR/RFLB/ if $rot eq 'y';
    $post =~ y/URDL/LURD/ if $rot eq 'z';
    if ($rot eq 'x') {
      $post =~ y/E/e/;
      $post =~ y/S/E/;
      $post =~ s/e/S'/g;
    }
    if ($rot eq 'y') {
      $post =~ y/S/s/;
      $post =~ y/M/S/;
      $post =~ s/s/M'/g;
    }
    if ($rot eq 'z') {
      $post =~ y/E/e/;
      $post =~ y/M/E/;
      $post =~ s/e/M'/g;
    }
    
    # Attach the modified suffix to the prefix and clean up
    $alg = "$pre$post";
    $alg =~ s/''//g;
    $alg =~ s/'2/2/g;
    $alg =~ s/  +/ /g;
    $alg =~ s/^ | $//g;
  }
  
  return $alg;
}

sub BTM {
  my ($alg) = @_;
  #say $alg;
  return 1 * ($alg =~ y/FSBLMRDEU//d);
}

sub minimizeForBTM {
  my ($alg) = @_;
  
  my @moves = split / /, $alg;
  push @moves, 'sentinel';
  my $lastAxis = 0;
  my @axisMoves = ();
  
  my $outAlg = "";
  for my $move (@moves) {
    my $axis = 1*($move =~ /[DEU]/) + 2*($move =~ /[LMR]/) + 3*($move =~ /[FSB]/);
    #print "$move $axis\n";
    if ($lastAxis and $axis != $lastAxis) {
      $normalizedAxisMoves = $bestAxisMoves[hash("@axisMoves")];
      print "[@axisMoves] => [$normalizedAxisMoves] $. $alg\n" if BTM("@axisMoves") > BTM($normalizedAxisMoves);
      $outAlg .= " $normalizedAxisMoves";
      @axisMoves = ();
    }
    if ($axis) {
      push @axisMoves, $move;
    }
    $lastAxis = $axis;
  }

  $outAlg =~ s/^ //;
  return $outAlg;
  return removeRotations($outAlg);
}

for my $scrambleNr (1 .. 5) {
  say "Scramble $scrambleNr ...";
  
  # First optimize all solutions
  %forCubeExplorer = ();
  open my $fh, '<', "ChenOutputs/ChenOutput_scramble$scrambleNr.txt";
  <$fh>; <$fh>; <$fh>;
  while ($line = <$fh>) {

    # Only single spaces, none at start/end
    $line =~ s/\s\s+/ /g;
    $line =~ s/^\s|\s$//g;
    
    # Separate length and moves
    ($length, $moves) = split / /, $line, 2;
    
    # Invert the generator so it's a solution, and remove the rotations
    $moves = invertAlg($moves);
    $moves = removeRotations($moves);

    # BTMize the reduction part
    ($movesRedux, $moves3x3x3) = $moves =~ /(.*?) (([FBLRUDMES][2']? ?)*$)/;
    $movesRedux = minimizeForBTM($movesRedux);
    $moves = removeRotations("$movesRedux $moves3x3x3");
    
    # Split into the two phases
    ($movesRedux, $moves3x3x3) = $moves =~ /(.*?) (([FBLRUDMES][2']? ?)*$)/;
    
    if (!$seen{$movesRedux}++) {
      $btm = BTM($movesRedux);
      
      # We can always try to finish without cancellation between reduction and 3x3 phases.
      $forCubeExplorer{$btm} .= "$moves3x3x3 // line$. BTM $btm redux: $movesRedux\n";
      
      # Try cancellations
      ($lastReduxMove = $movesRedux) =~ s/.* //;
      $layers = 'UDE' if $lastReduxMove =~ /[DEU]/;
      $layers = 'LRM' if $lastReduxMove =~ /[LMR]/;
      $layers = 'FBS' if $lastReduxMove =~ /[FSB]/;
      for my $layer (split //, $layers) {
        for my $angle (("", "2", "'")) {
          $move = "$layer$angle";
          $invMove = invertMove($move);
          $changedRedux = minimizeForBTM("$movesRedux $move");
          if (BTM($changedRedux) <= $btm  and  !$seen{removeRotations($changedRedux)}++) {
            $forCubeExplorer{$btm} .= "  $invMove $moves3x3x3 // line$. BTM $btm redux: $changedRedux\n";
            #say "$movesRedux\n$changedRedux   $invMove $moves3x3x3" if $angle ne "2" or $layer =~ /[MES]/;
          }
          if ($layer =~ /[ULF]/) {
            ($layer2 = $layer) =~ y/ULF/DRB/;
          #($rLayers = $layers) =~ s/.*$layer//;
          #for my $layer2 (split //, $rLayers) {
            for my $angle2 (("", "2", "'")) {
              $move2 = "$layer2$angle2";
              $invMove2 = invertMove($move2);
              $changedRedux = minimizeForBTM("$movesRedux $move $move2");
              if (BTM($changedRedux) <= $btm  and  !$seen{removeRotations($changedRedux)}++) {
                $forCubeExplorer{$btm} .= "  $invMove2 $invMove $moves3x3x3 // line$. BTM $btm redux: $changedRedux\n";
                #say " $movesRedux\n  $invMove2 $invMove   $moves3x3x3 // line$. BTM $btm redux: $changedRedux\n";
              }
            }
          }
        }
      }
    }
  }
  close $fh;

  # Now save the tasks to CubeExplorer input files (and corresponding files naming the reductions)
  open $ceiFile, ">", "CubeExplorerInputs/BTM_${scrambleNr}.txt";
  open $foo, ">", "CubeExplorerInputs/FOO_${scrambleNr}.txt";
  for my $btm (sort {$a <=> $b} keys %forCubeExplorer) {
    say $btm;
    print $ceiFile $forCubeExplorer{$btm};
    $tmp = $forCubeExplorer{$btm};
    $tmp =~ s!(.*) /.*: (.*)!$2 $1!g;
    print $foo $tmp;
  }
  close $ceiFile;
  close $foo;
}