Finding in a string S if is possible to create a set with perfect cubes or perfect squares with elements of S.

Question

You have a sequence $S[1...n]$ with $n$ digits(0 to 9) and you wanna know if its possible break then in perfect square or perfect cube. For example, if $S = 1252714481644$, then the answer is $YES$ because $S$ can set as: $125, 27, 144, 81, 64, 4$ that are $(125 = 5^2, 27 = 3^3, 144 = 12^2, 81 = 9^2, 64 = 8^2, 4 = 2^2$). Other possible solution is $1,25,27,144,8,16,4,4$. Write an PD algorithm that show the sequence that satisfy(or not) the condition. The complexity of the algorithm should be $O(n^2)$. In case of $YES$ show the sequence you found out.

This is a subtype of the problem sumsubset?!

Assume that the time to verify if the number is a perfect cube or perfect square takes time $O(1)$.

Answer 1

This being homework one should not provide a readymade solution that doesn't require any additional effort to understand and use. For this reason I am sending a Perl program that does what you requested but requires some sophistication one the part of the reader. In fact it does a little bit more, collecting all solutions as opposed to just one. If you can read this program then you have definitely understood the method (dynamic programming). Good luck.

#! /usr/bin/perl -w
#

sub seqsqcube {
    my ($dref, $from, $to, $res) = @_;

    return $res->[$from][$to]
      if defined($res->[$from][$to]);

    my %allres = ();

    my $value = 0;
    for($dindx=$from; $dindx<=$to; $dindx++){
      $value = 10*$value + $dref->[$dindx];
    }

    my $sqroot = ($value>0 ? int(0.5+exp(log($value)/2.0)) : 0);
    my $cuberoot = ($value>0 ? int(0.5+exp(log($value)/3.0)) : 0);

    if(($value-$sqroot*$sqroot == 0) ||
       ($value-$cuberoot*$cuberoot*$cuberoot == 0)){
      $allres{direct} = join('', @$dref[$from..$to]);
    }


    for(my $pos=$from; $pos<$to; $pos++){
      my $left = seqsqcube($dref, $from, $pos, $res);
      my $right = seqsqcube($dref, $pos+1, $to, $res);

      if(scalar(%$left) && scalar(%$right)){
          push @{$allres{recursive}}, [$left, $right];
      }
    }

    $res->[$from][$to] = \%allres;
    return $res->[$from][$to];
}

sub allsols {
    my ($ref, $memo) = @_;

    return $memo->{$ref} if exists($memo->{$ref});

    my %strings;

    if(exists($ref->{direct})){
      $strings{$ref->{direct}} = 1;
    }

    if(exists($ref->{recursive})){
      foreach my $pair (@{$ref->{recursive}}){
          my $left = allsols($pair->[0], $memo);
          my $right = allsols($pair->[1], $memo);

          foreach my $lstr (@$left){
            foreach my $rstr (@$right){
                $strings{"$lstr,$rstr"} = 1;
            }
          }
      }
    }

    my @unique = keys(%strings);
    $memo->{$ref} = \@unique;
    return $memo->{$ref};
}

MAIN: {
    my $input = shift || '252781';

    my @digits = split(//, $input);
    my $count = scalar(@digits);

    my $result = [];
    seqsqcube(\@digits, 0, $count-1, $result);

    if(!scalar(%{$result->[0][$count-1]})){
      print "no solution found\n";
    }

    my $memo = {};
    foreach my $str (@{allsols($result->[0][$count-1], $memo)}){
      print "$str\n";
    }
}