in reply to Re: string containing characters
in thread string containing characters

Note: Possibly ok, but doesn't handle duplicates in $MATCHALL

Replies are listed 'Best First'.
Re^3: string containing characters
by harangzsolt33 (Deacon) on Jan 22, 2025 at 01:17 UTC
    Yeah, that's true. But we could turn it around and then it works:

    #!/usr/bin/perl -w use strict; use warnings; my $SAMPLE = "Hello World\r\n"; my $MATCHALL = "ooreH\r\n"; my $SAMPLE_LENGTH = length($SAMPLE); $SAMPLE =~ s/[\Q$MATCHALL\E]{1}//g; if (length($SAMPLE) == $SAMPLE_LENGTH - length($MATCHALL)) { print "\nCONTAINS ALL THE CHARACTERS\n"; } else { print "\nDOES NOT CONTAIN ALL THE CHARACTERS\n"; } exit;

      That doesn't help. Try $SAMPLE = "oxx"; $MATCHALL = "oox";.

        Hmm... Yeah, it's not as simple as I thought. Well, after giving this much thought, I came up with a sub that counts the characters in the arguments and returns 1 if they are all using the same amount of characters. This SHOULD work. :)

        # # This function compares its arguments, and if they are all made up # of the same characters but perhaps rearranged in different order, # then the function returns 1; otherwise returns zero. # # Note: This function not only makes sure that the same characters # occur in both strings but that they are the same count as well. # So, hasSameChars("ABC", "AABC") will return zero. # # Usage: INTEGER = hasSameChars(STRINGS...) # sub hasSameChars { # First, we make sure each argument has the same type and same lengt +h. @_ > 1 or return 0; my $THISLEN = -2; # Current argument length my $PREVLEN = -2; # Previous argument length # When we encounter an undefined scalar, # we treat it as if it had length -1. # IF ALL arguments are undefined, then the function should return 1. # If one argument is undefined, then all arguments should be undefin +ed. # If one argument is a string, then all arguments # must be a string of the same length. So, this is what we're # trying to decide here: foreach (@_) { $THISLEN = (defined $_) ? length($_) : -1; if ($PREVLEN > -2) { $PREVLEN == $THISLEN or return 0; } $PREVLEN = $THISLEN; } # Okay, at this point, we know that all arguments are # the same type and same length. If they are all undefined or # empty, then we can exit right here: $THISLEN < 1 and return 1; # -------------------------------------------------------------- # # This was my first solution, however # I found a much more efficient and faster way than this: # # my $SAMPLE = join('', sort(split(//, shift))); # foreach (@_) # { # join('', sort(split(//, $_))) eq $SAMPLE or return 0; # } # return 1; # # Instead of sorting the characters of both strings, I use a regex # replace to remove each character from both strings. For example, # after we remove every instance of letter "A" from a string, its # length will be reduced. If the string contains 15 As, then any other # string that has the same makeup must have 15 As. So, if we remove # all the letter As from any other string, the length of those # strings must drop by the same amount. So, we just have to make # sure that as we remove characters from other strings, the # length drops by the same amount as it did in the first string. # If the length-drops match, then the strings # have the same character makeup. # Here we analyze the character makeup of the first string: my $A = shift; # A copy of the first argument my $CHARS = ''; # Unique characters in the first string my @LEN; # Remaining string length after chars removed my $C; # just a character while (length($A)) { $C = substr($A, 0, 1); # Take the first character $A =~ s/\Q$C\E//g; # Remove every trace of it push(@LEN, length($A)); # Record length drop after removed $CHARS .= $C; # Record the character itself } # $CHARS now contains a list of unique characters # used in the first argument. my $U = length($CHARS); # Number of unique characters used my $P; # Unique Character Pointer # === COMPARE CHARACTER MAKEUP OF OTHER STRINGS ================== foreach (@_) { $A = $_; # Copy next argument $P = 0; # Start with first unique char while ($P < $U) { $C = substr($CHARS, $P, 1); # Look at next unique character $A =~ s/\Q$C\E//g; # Remove every trace of it length($A) == $LEN[$P++] or return 0; # Check length drop } } return 1; }