<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
use strict;

=head1 Beads on a necklace

"Necklaces are manufactured by arranging 13 white beads and three black beads
on a loop of string. How many different necklaces can be produced in this
way? (The positioning of the fastening may be ignored.)"
  Discrete Mathematics, 2ed, Norman L. Biggs, p289

The main program is at the bottom of the file. The file contains three
subroutines which are called during the program's execution. Above each
subroutine is a short explanation of what it does and what it returns.

=head2 generate all_possibilities

input: -
output: an array of strings representing all possible necklaces

Generates all possible necklaces by placing the three black beads in all
possible ways. Without loss of generality, we can call the positions of the
three black beads b1, b2 and b3 according to which order they occur. We then
have

   0 &lt;= b1 &lt; b2 &lt; b3 &lt;= 15

which we can break up into

   0  &lt;= b1 &lt;= 13
   b1 &lt;  b2 &lt;= 14
   b2 &lt;  b3 &lt;= 15

and so we iterate through all possible combinations using three nested for
loops. The array will consist of all 560 (13*14*15/4) possible strings.

=cut

sub generate_all_possibilities {
    my @possibilities;
    for my $b1 (0..13) {
        for my $b2 ($b1+1..14) {
            for my $b3 ($b2+1..15) {
                # necklace with 16 white beads
                my $necklace = 'W' x 16;
                # place black beads on the three positions
                substr($necklace, $b1, 1) = 'B';
                substr($necklace, $b2, 1) = 'B';
                substr($necklace, $b3, 1) = 'B';
                # add the result to the array
                push @possibilities, $necklace;
            }
        }
    }
    return @possibilities;
}

=head2 generate_all_rotations

input: a string
output: an array of all possible rotations of the string, i.e. the same
        string rotated in all possible ways

A rotation of a string is another string where a number of characters in the
beginning have been placed in the end. Thus, for example, "cool" and "olco"
are rotations of each other. The array will contain as many strings as there
are characters in the input string.

=cut

sub generate_all_rotations {
    my $necklace = shift @_;
    my @rotations;
    for (0..length $necklace) {
        # add the current string to the array
        push @rotations, $necklace;
        # rotate one step by placing first letter last
        $necklace = substr($necklace, 1) . substr($necklace, 0, 1);
    }
    return @rotations;
}

=head2 canonic

input: a string
output: the lexicographically smallest string out of all possible rotations
        and reversals of the input string

("Lexicographically smallest" is just a fancy way of saying "occurring first
in the dictionary".)

Finding an equivalence class can be done by choosing a representative element
within this class. The lexicographically smallest string is a good such
representative, since it is unique and easy to compute. For example, if the
input it BWWBWB, all possible rotations and reversals are

          pure         rotation+
        rotation       reversal
        --------       --------
         BWWBWB         BWBWWB
         WWBWBB         BBWBWW
         WBWBBW         WBBWBW
         BWBBWW         WWBBWB
         WBBWWB         BWWBBW
         BBWWBW         WBWWBB

and of these, BBWBWW is the lexicographically smallest.

=cut

sub canonic {
    my $necklace = shift @_;
    my @all_rotations = generate_all_rotations $necklace;
    # reverse all the strings in @all_rotations and store in a new array
    my @all_rots_and_revs = map { scalar reverse } @all_rotations;
    my @all_symmetries = (@all_rotations, @all_rots_and_revs);
    # sort the elements and return the first one (not a quick way to find the
    # minimal element, but speed is not an issue here)
    return (sort @all_symmetries)[0];
}

=head2 main program

The program generates all possible necklaces, including duplicates. It then
goes through these and computes the canonic representative for each. The
number of unique necklaces will be the number of unique such representatives,
so we'll use a hash to simulate a set of representatives. The answer will then
simply be the size of this set.

=cut

my @possibilities = generate_all_possibilities;
# ++ will create a new hash key (assuming it to be zero) if it did not
# previously exist. this procedure is known as 'autovivification' and is
# very useful. note that we are not interested in the actual values in the
# hash, just its final size
my %equivalents;
++$equivalents{canonic $_} for @possibilities;
print "There are ", scalar keys %equivalents, " different necklaces.\n";
</pre></body></html>