All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > General
Unique Necklaces (Posted on 2004-08-18) Difficulty: 5 of 5
A circular necklace contains n beads. Each bead is black or white. How many different necklaces can be made with n beads?

There is no clasp to identify a specific point on the chain, and a flipped over necklace is still the same necklace.
_____________________________

To get you started:

With 1 bead, the necklace can be either 1 black or 1 white bead.

With 2 beads, the necklace can be either 2 black, 2 white, or 1 black-1 white

With 3 beads, the necklace can be either 3 black, 3 white, 2 black-1 white, 2 white-1 black, etc...

# Beads  Number of Necklaces
   1          2
   2          3
   3          4
   4          6
   5          8
   6         13

No Solution Yet Submitted by SilverKnight    
Rating: 4.0000 (4 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
There is an error is this puzzle | Comment 4 of 15 |

Not a big error. But...

Unless my program is flawed, for the case of 6 beads, there are actually 14, not 13, possible necklaces. The other values given  are correct. 

black black white white white black
black black black black white black
black white white black white white
white white white white black black
white black black white white black
white white white black white black
white black white white white white
white black white black black black
black white black white black white
black black white black black white
black white white black black black
white black black white black white
black black black black black black
white white white white white white
  
The program that found them is:
 
Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Math
Module Module1
    Sub Main()
        Randomize()
        Dim strgoagain As String
        strgoagain = "y"
        While strgoagain = "y"
            mainline()
            Console.WriteLine("Again ? (y/n)")
            strgoagain = LCase(Console.ReadLine()) '
        End While
    End Sub
   
Sub mainline()
        Dim intallnecklaces(,) As Integer
        Dim intnecklace() As Integer
        Dim intnecklace2() As Integer
        Dim intbeads As Double
        Dim intloop As Integer
        Dim intloop2 As Integer
        Dim dblcombos As Double
        Dim intdistinctones As Integer
        intbeads = 0
        While intbeads <= 0
            Console.WriteLine("How many beads ?")
            intbeads = Int(Console.ReadLine())
        End While
        ReDim intnecklace(intbeads)
        ReDim intnecklace2(intbeads)
        intloop = intbeads - 1
        dblcombos = 2 ^ intbeads
        ReDim intallnecklaces(dblcombos, intbeads)
        intloop2 = dblcombos - 1
        For index1 As Integer = 0 To intloop2
            For index2 As Integer = 0 To intloop
                intallnecklaces(index1, index2) = 999
            Next
        Next
        While intallnecklaces(intloop2, 0) = 999
            buildallnecklaces(intnecklace, intloop, _
            intallnecklaces, intloop2)
        End While
        countdistictones(intallnecklaces, intloop2, _
        intnecklace, intnecklace2, intloop)
        intdistinctones = 0
        Console.WriteLine(" ")
        Console.WriteLine("ALL UNIQUE NECKLACES:")
        For index1 As Integer = 0 To intloop2
            If intallnecklaces(index1, 0) <> 999 Then
                intdistinctones += 1
                displaynecklace(index1, _
                intallnecklaces, intloop)
            End If
        Next
        Console.WriteLine( _
        "For " & Str(intbeads) & " beads, there are " & _
        Str(intdistinctones) & " possible necklaces.")
    End Sub
   
Sub buildallnecklaces(ByRef intnecklace, ByRef intloop, _
    ByRef intallnecklaces, ByRef intloop2)
        Dim intmatch As Integer
        For index1 As Integer = 0 To intloop
            intnecklace(index1) = Int((1 - 0 + 1) * Rnd()) + 0
        Next
        For index1 As Integer = 0 To intloop2
            intmatch = 0
            If intallnecklaces(index1, 0) = 999 Then
                For index2 As Integer = 0 To intloop
                    intallnecklaces(index1, index2) = _
                    intnecklace(index2)
                Next
                Exit Sub
            End If
            For index2 As Integer = 0 To intloop
                If intallnecklaces(index1, index2) = _
                intnecklace(index2) Then
                    intmatch += 1
                End If
            Next
            If intmatch = intloop + 1 Then
                Exit Sub
            End If
        Next
    End Sub
   
Sub countdistictones(ByRef intallnecklaces, ByRef intloop2, _
    ByRef intnecklace, ByRef intnecklace2, ByRef intloop)
        For index1 As Integer = 0 To intloop2 - 1
            If intallnecklaces(index1, 0) <> 999 Then
                For index2 As Integer = 0 To intloop
                    intnecklace(index2) = _
                    intallnecklaces(index1, index2)
                Next
                For index3 As Integer = index1 + 1 To intloop2
                    If intallnecklaces(index3, 0) <> 999 Then
                        For index4 As Integer = 0 To intloop
                            intnecklace2(index4) = _
                            intallnecklaces(index3, index4)
                        Next
                        eraseaduplicate(intallnecklaces, _
                        index3, intnecklace, _
                        intnecklace2, intloop)
                    End If
                Next
            End If
        Next
    End Sub
   
Sub eraseaduplicate(ByRef intallnecklaces, _
    ByRef index3, ByRef intnecklace, _
    ByRef intnecklace2, ByRef intloop)
        Dim introtate As Integer = 0
        Dim intsave As Integer
        introtate = 0
        While introtate < intloop + 1
            intsave = intnecklace2(0)
            For index1 As Integer = 0 To intloop - 1
                intnecklace2(index1) = _
                intnecklace2(index1 + 1)
            Next
            intnecklace2(intloop) = intsave
            dupcheck(intnecklace, intnecklace2, intloop)
            If intnecklace2(0) = 999 Then
                Exit While
            End If
            introtate += 1
        End While
        If intnecklace2(0) = 999 Then
            For index4 As Integer = 0 To intloop
                intallnecklaces(index3, index4) = 999
            Next
        End If
    End Sub
   
Sub dupcheck(ByRef intnecklace, _
    ByRef intnecklace2, ByRef intloop)
        Dim intmatch As Integer
        intmatch = 0
        For index1 As Integer = 0 To intloop
            If intnecklace(index1) = intnecklace2(index1) Then
                intmatch += 1
            End If
        Next
        If intmatch = intloop + 1 Then
            For index1 As Integer = 0 To intloop
                intnecklace2(index1) = 999
            Next
        End If
    End Sub
   
Sub displaynecklace(ByRef indexn, _
    ByRef intallnecklaces, ByRef intloop)
        Dim strstring As String
        Dim strstring2 As String
        Dim intdummy1 As Integer
        Dim intdummy2 As Integer
        strstring = ""
        For index2 As Integer = 0 To intloop
            Select Case intallnecklaces(indexn, index2)
                Case 0
                    strstring2 = "white"
                Case 1
                    strstring2 = "black"
                Case Else
                    intdummy1 = 1
                    intdummy2 = 0
                    intdummy1 /= intdummy2
            End Select
            strstring &= strstring2
            strstring &= " "
        Next
        Console.WriteLine(strstring)
        Console.WriteLine("Press ENTER for next necklace.")
        Console.ReadLine()
    End Sub
End Module
 

Edited on August 19, 2004, 10:08 am
  Posted by Penny on 2004-08-19 10:07:43

Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (3)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information