harangzsolt33 has asked for the wisdom of the Perl Monks concerning the following question:
I have a little problem that might as well be a "homework" assignment. I already have a solution, but my question is is there a nicer or more efficient solution to this problem?
I want to write a function that tests its arguments to make sure that they are all made up of the same characters. My assumption is that if two strings have the same makeup, then they are going to have the same length. So, for example, if a string is made up of 5 As and 2 Bs, then you could have "AAAAABB" or "AABAABA" or "AABBAAA" or any other configuration, BUT they will always be 7 bytes altogether, never more or less. So, first thing I want to make sure is that each argument has the same length. All arguments could be empty strings, or all arguments could be undefined, or all arguments could be N bytes long. Once we figure this out, then we have to find out if the strings are made up of the same stuff.
The first idea that came to my mind is that I'm going to sort the letters. If the sorted strings are the same, then the string has the same makeup. If not, the function returns zero. But could there be a faster solution, something I haven't thought of?
#!/usr/bin/perl use strict; use warnings; Test(); sub hasSameChars { # Make sure each argument has the same type and same length. @_ > 1 or return 0; # Require at least 2 arguments # Check if arguments are of the same length. my $THISLEN = -2; # Current argument's length my $PREVLEN = -2; # Previous argument's length 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, # then $THISLEN will be -1 or if they are all empty strings, then # $THISLEN will be zero, so we can exit right here in that case: $THISLEN < 1 and return 1; # We end up here if all arguments are defined, and all are the same +length. # Check if arguments have the same makeup: my $SAMPLE = join('', sort(split(//, shift))); foreach (@_) { join('', sort(split(//, $_))) eq $SAMPLE or return 0; } return 1; } sub Test { my $ERRORS = 0; # TESTING TRUE: hasSameChars("Hello World!", "Hello World!") == 1 or + $ERRORS++; hasSameChars("Hello World!", "Hdll!ooreWl ") == 1 or + $ERRORS++; hasSameChars("Hello World!", "Hdll!ooreWl ", "Hlde! Wlloor") == 1 or + $ERRORS++; hasSameChars("FALLEN", "LENFAL", "ELFALN") == 1 or + $ERRORS++; hasSameChars(undef, undef, undef) == 1 or + $ERRORS++; hasSameChars('', '', '', '') == 1 or + $ERRORS++; hasSameChars('A', 'A', 'A', 'A') == 1 or + $ERRORS++; hasSameChars("\r\n\t\0\0\1", "\0\1\t\0\n\r", "\n\1\r\t\0\0") == 1 or + $ERRORS++; hasSameChars('ABB', 'BBA', 'BAB', 'BBA') == 1 or + $ERRORS++; hasSameChars(' ', ' ', ' ', ' ') == 1 or + $ERRORS++; hasSameChars("ABC", "CAB", "BAC", "BCA", "ACB", "ABC") == 1 or + $ERRORS++; # TESTING FALSE: hasSameChars("\r\n\t\0\1\2", "\0\2\t\1\n\r", "\t\t\r\1\2\n") == 0 or + $ERRORS++; hasSameChars("Hello World!", "Hdll!ooreWl ", "Hlde! Wlloo") == 0 or + $ERRORS++; hasSameChars("Hello World!", "Hdll!ooreWl") == 0 or + $ERRORS++; hasSameChars("ABC", "C_B", "BAC", "BCA", "ACB", "ABC") == 0 or + $ERRORS++; hasSameChars("ALLEN", "ELLEN", "HALLEN", "HELLEN") == 0 or + $ERRORS++; hasSameChars("FALLEN", "Lenfal", "ELFALN") == 0 or + $ERRORS++; hasSameChars("FALLEN", "FALLEN ") == 0 or + $ERRORS++; hasSameChars(undef, "FALLEN", "FALLEN") == 0 or + $ERRORS++; hasSameChars("FALLEN", undef, "FALLEN") == 0 or + $ERRORS++; hasSameChars("FALLEN", "FALLEN", undef) == 0 or + $ERRORS++; hasSameChars('', undef, undef) == 0 or + $ERRORS++; hasSameChars('ABB', 'ABA', 'BAA', 'BAA') == 0 or + $ERRORS++; hasSameChars(' ', ' ', ' ', "\t") == 0 or + $ERRORS++; print "\n\n ERRORS = $ERRORS \n\n"; }
|
|---|