RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved string augmentation and analysis. (Note that this ends today.)

Task 1: Convert Palindrome

You are given a string.

Write a script to convert the given string to palindrome by adding characters in front of it.

Obviously there's a trivial solution to this: just reverse the string and prepend that reversal. So instead I worked to find the shortest possible palindrome.

I work on an array of characters. Here's the PostScript: first, a test to see whether an array is a palindrome.

/is_palindrome {
    0 dict begin
    /a exch def
    /l a length def

Assume it is.

    true

Check from the start to half way along the string.

    0 1 l 2 idiv {
        /i exch def

If the character i steps in from the start doesn't match the one i steps in from the end, it isn't. (And stop checking.)

        a i get a l i sub 1 sub get ne {
            pop false
            exit
        } if
    } for
    end
} bind def

Now do to the actual work.

/convertpalindrome {
    0 dict begin

Store the string as an array.

    s2a /c0 exch def

Start with zero additional characters.

    /i 0 def
    {

Make a copy of the base string.

        /c c0 deepcopy def

For i iterations (so the first time round we'll do nothing to the copy),

        0 1 i 1 sub {
            /n exch def

take a character from the right spot towards the end of the original, and add it to the beginning of the copy. (So given "ABACD" we'd generate "DABACD", "DCABACD", etc.)

            c c0 c0 length i sub n add get apush.left /c exch def
        } for

If that copy is now a palindrome, convert it back to a string and exit.

        c is_palindrome {
            c a2s
            exit
        } if

Otherwise increment and try again. We'll always get a terminating state, the one with the full reversed string I mentioned at the top.

        /i i 1 add def
    } loop
    end
} bind def

Task 2: Words Length Product

You are given an array of strings.

Write a script to return the maximum value of

len($words[i]) * len($words[j])

where the two words do not share common letters. If no such two words exist, return 0.

When I see a problem like this that calls for sets, and I contemplate doing it in languages that don't have sets, I become unenthused. But here it is in Perl.

sub wordslengthproduct($a) {

Convert each input string into a pseudo-set of characters.

  my @ws = map {{map {$_ => 1} split '', $_}} @{$a};
  my $mx = 0;

Iterate over each pair of strings (ignoring order).

  foreach my $i (0 .. $#ws - 1) {
    foreach my $j ($i + 1 .. $#ws) {

Go through the long tedious slog of calculating a set intersection.

      my $clean = 1;
      foreach my $ic (keys %{$ws[$i]}) {
        if (exists $ws[$j]->{$ic}) {
          $clean = 0;
          last;
        }
      }
      if ($clean) {
        foreach my $jc (keys %{$ws[$j]}) {
          if (exists $ws[$i]->{$jc}) {
            $clean = 0;
            last;
          }
        }
      }

If the sets are disjoint, calculate a value for this pair.

      if ($clean) {
        $mx = max($mx, length($a->[$i]) * length($a->[$j]));
      }
    }
  }
  $mx;
}

But having proper sets (in Raku) makes this same code so much cleaner!

sub wordslengthproduct(@a) {
    my @ws = @a.map({Set.new($_.comb)});
    my $mx = 0;
    for 0 .. @ws.end - 1 -> $i {
        for $i + 1 .. @ws.end -> $j {
            if (@ws[$i] (&) @ws[$j]).elems == 0 {
                $mx = max($mx, @a[$i].chars * @a[$j].chars);
            }
        }
    }
    $mx;
}

Full code in all tagged languages is on codeberg.