Dear Monks!

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";
}

[download]

In reply to Check if string A and B are made up of same chars by harangzsolt33

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.