Re: [FWP] subexpr nearest the 'middle' of expr

[abigail@foad.org]

On Thu, Mar 08, 2001 at 11:37:57AM -0800, Jacob Carpenter wrote:
> Let's see a subroutine that takes three (3) arguments [expr, subexpr,
> replacement] -- call them whatever you like in the actual sub -- and returns
> "expr" with the "subexpr" nearest the middle (currently, I intend 'middle'
> to mean the byte position closest to half-the-byte-length of the string)
> replaced with "replacement". Subexpr should be a literal string. and should
> be centered on the middle, not begin in the middle -- i.e.
> &replace_mid('aaaaa', 'aaa', 'BBB') is to return 'aBBBa' not 'aaBBB'.
> 
> In the case that the same subexpr is found 'just-left-of-center' and
> 'just-right-of-center,' you have discretion in which your sub favors -- i.e.
> &replace_mid('aaaa', 'a', 'B') may return either 'aBaa' or 'aaBa'. I'd like
> to see some for each way.
> 
> I'm certain this will clearly illustrate that TMTOWTDI, and I'm looking
> forward to that. Ultimately, I have a feeling that this will result in a
> golf match, but initially, I'm just interested in seeing interesting ways of
> doing this.


All your examples have subexpressions without regex meta characters,
so it's clear what to do.

But what if I call replace_mid ('aaaaa', 'a+', 'B')? What is the intended
return value? 'B'? 'aaBaa'? 'aBa'? 'aB'? 'Ba'? All equally good?

Or do you mean string where you write expr? (The first argument of 
replace_mid being a regex doesn't make much sense).


If the arguments are just strings, there's a simple algorithm.
Calculate where the substring should start if it's to be put exactly
in the middle, then from that position, use index() and rindex() to
find the "next" and "previous" match. Compare which one is closest to
the middle, then substitute:

    sub replace_mid {
        my ($string, $substring, $replacement) = @_;

        my $N = length $string;
        my $M = length $substring;

        return if $N < $M;   # No solution possible.

        # Find the mid.
        my $mid = ($N - $M) / 2;

        my $index1 =  index $string, $substring, $mid;
        my $index2 = rindex $string, $substring, $mid;

        return if $index1 == -1 && $index2 == -1;   # No match.

        # Two cases of only a match when going in one direction.
        if ($index1 == -1) {
            substr $string, $index2, $M, $replacement;
            return $string;
        }
        if ($index2 == -1) {
            substr $string, $index1, $M, $replacement;
            return $string;
        }

        # Now we have two potential candidates.
        if ($N - ($index2 + $M) <= $index1) {
            # rindex wins.
            substr $string, $index2, $M, $replacement;
            return $string;
        }
        else {
            #  index wins.
            substr $string, $index1, $M, $replacement;
            return $string;
        }
    }


It's too late though to check it for off-by-one errors though, but a
few tests seemed to give the right answers.



Abigail

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe