Kleiner Wettbewerb: Das k-Akkord-Problem einer n-Tonleiter

gaussmath

gaussmath

Vice Admiral Special
Mitglied seit
17.11.2005
Beiträge
585
Renomée
1
Da der Thread "Programmierwettbewerb" ein wenig eingeschlafen ist, würde ich diesen
Vorschlag machen.
Bei diesem Problem geht es darum, herauszufinden wieviel verschiedene n-Akkorde
(n Tasten gleichzeitig drücken/spielen) es in bei einer k-Tonleiter ( normalerweise k=12)
gibt. Das Problem ist keinesfalls trivial. Der Binomialkoeffizient hillft da nicht weiter,
da sich durch Transponalverschiebung (1. Taste/Ton + m-Verschiebung, 2.Taste/Ton + m-Verschiebung,..., k-te.Taste/ton + m-Verschiebung) des Akkordes Äquivalenzklassen bilden. Der Musiker spricht dann von ähnlichen/verwandten Akkorden.
Dazu kommt noch der sog. "Uhr-Effekt". Das heißt: Befindet sich ein Ton, der um m Töne
verschoben werden soll auf dem letzten Ton der n-Tonleiter, so "bricht" dieser nicht ab,
sondern beginnt wieder von vorne auf der Tonleiter.
Beispiel zur Verschiebung: m=2 , n=6, k=1
() () () () () (1)
wird zu:
() (1) () () () ()

Beispiel zur Äquivalenz: n=6, k=2, m=2
() () () (1) () (1) <=> () (1) () () () (1)

Lösungen habe ich bisher noch keine finden können. Nicht mal Pseudo-Code.
Ich habe mit der Programmierung bereits begonnen und mich für VBA entschieden,
da die Visualisierung sehr einfach umsetzbar ist.
Mein Ansatz: 1. alle Permutationen ohne Wiederholungen von k Akkorden aus n Tönen
2. Streichen aller ähnlichen/äquivalenten Akkorde

Eines ist klar: die Verteilung muß irgendwie binomial bzw. normalverteilt sein!

Ich hoffe, ich konnte Euer Interesse wecken.
 
Zuletzt bearbeitet:
habs jetzt in C geschrieben, Methode so wie du es beschrieben hast, ähnlich dem Sieb des Eratosthenes. Für k = 30 kommt Folgendes raus (insg. 35792567 verschiedene Akkorde, A64 3200+ brauchte 76 Sekunden für die Suche):
Code: 
 1:     1
 2:     15
 3:     136
 4:     917
 5:     4751
 6:     19811
 7:     67860
 8:     195143
 9:     476913
10:     1001603
11:     1820910
12:     2883289
13:     3991995
14:     4847637
15:     5170604
16:     4847637
17:     3991995
18:     2883289
19:     1820910
20:     1001603
21:     476913
22:     195143
23:     67860
24:     19811
25:     4751
26:     917
27:     136
28:     15
29:     1
Symmetrie kommt davon, dass zu einem m-Akkord immer ein (k-m)-Akkord dazu gehört (tastenweise invers).

MfG Lex
 
Extrem cool!!!!
Was hat Du denn für die 12-Tonleiter raus? 1, 6, 12, ...?
 
Mein Prog unter VBA sieht so aus:

Code: 
Option Explicit
Dim KombMem$
Public Const accord = 2
Public tempfeld(1 To accord)


Sub main()
'K Kombinationen aus N ohne Wiederholung
'Die Kombinationen werden in eine Datei im
'Textformat Zeichengetrennt (CSV) ausgegeben

Dim N&
Dim k&
Dim xNs$
Dim xNa As Variant
Dim xi&
Dim xfn&
Dim xFile$

N& = 12 'Beispiel
k& = accord  'Beispiel

xFile$ = "C:\test.txt"

xfn& = FreeFile
Open xFile For Append As xfn&

ReDim xNa(N - 1) As String
For xi = 0 To N - 1
xNa(xi) = CStr(N - xi)
Next

Kombination xfn&, xNa, k&, ""
Close xfn



Workbooks.OpenText FileName:="C:\test.txt", Origin:=xlWindows, StartRow:= _
        1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
        3, 1))


Dim i As Integer
Dim j As Integer
Dim hilfsfeld(1 To accord)
For i = 1 To accord
hilfsfeld(i) = 0
Next
'
'    Sheets("test").Cells.Select
'    Selection.NumberFormat = "0;[Red]0"
i = 1
Do While Sheets("test").Cells(i, 1).Value <> ""
If Sheets("test").Cells(i, 1).Value <> 1 Then

Rows(i).Select
Selection.Delete Shift:=xlUp
End If
i = i + 1
Loop


i = 1

Sheets("test").Select
Do
    If Sheets("test").Cells(i, 1).Value <> 1 Then
        Rows(i).Select
        Selection.Delete Shift:=xlUp
    End If
i = i + 1
Loop Until Sheets("test").Cells(i, 1).Value = ""

Dim count As Integer
Dim count2 As Integer
Dim proof As Boolean
proof = True


i = 1
Do
   count = 1
   For count = 1 To accord
   tempfeld(count) = Sheets("test").Cells(i, count).Value
   Next
   j = 1
   Do
   
       ruecke
      
       k = i
      
       Do
        count = 1
        count2 = 1
     
         For count = 1 To accord
         For count2 = 1 To accord
         
         If tempfeld(count) = Sheets("test").Cells(k, count2).Value Then
         hilfsfeld(count) = 1
 
         End If
         Next
         Next
         count = 1
         For count = 1 To accord
         If hilfsfeld(count) = 0 Then
         proof = False
    
         End If
         Next
         If proof = True Then
         Rows(k).Select
         Selection.Delete Shift:=xlUp
         End If
       
       k = k + 1
       proof = True
       count2 = 1
       For count2 = 1 To accord
       hilfsfeld(count2) = 0
       Next
       Loop Until Sheets("test").Cells(k + 1, 1).Value = ""

   j = j + 1
   Loop Until j = 12
i = i + 1
Loop Until Sheets("test").Cells(i + 1, 1).Value = ""

End Sub
Sub ruecke()
Dim count As Integer
count = 1
For count = 1 To accord
tempfeld(count) = tempfeld(count) + 1
If tempfeld(count) > 12 Then
tempfeld(count) = tempfeld(count) - 12
End If

Next



End Sub
Sub Kombination(xfn&, xNa As Variant, xk&, xKombi$)
'Procedur wird recursiv aufgerufen
Dim xExit As Boolean
Dim xKombiN$
Do While UBound(xNa) > (xk - 2)
If xKombi = "" Then
xKombiN = xNa(UBound(xNa))
Else
xKombiN = xKombi & ";" & xNa(UBound(xNa))
End If
If Not UBound(xNa) = 0 Then
ReDim Preserve xNa(UBound(xNa) - 1)
End If
If xk > 1 Then
Call Kombination(xfn, (xNa), xk - 1, (xKombiN))
Else
If Not KombMem = xKombiN Then

Print #xfn&, xKombiN
KombMem = xKombiN

End If
End If
If xExit Then Exit Do
If UBound(xNa) = 0 Then
xExit = True
End If
Loop
End Sub
 
Zuletzt bearbeitet:
nicht ganz, für k = 12:
Code: 
 1:     1
 2:     6
 3:     19
 4:     43
 5:     66
 6:     80
 7:     66
 8:     43
 9:     19
10:     6
11:     1

hier sind die Akkorde für m = 1..5:
Code: 
m = 1:  1 found :
1 0 0 0 0 0 0 0 0 0 0 0

m = 2:  6 found :
1 1 0 0 0 0 0 0 0 0 0 0
1 0 1 0 0 0 0 0 0 0 0 0
1 0 0 1 0 0 0 0 0 0 0 0
1 0 0 0 1 0 0 0 0 0 0 0
1 0 0 0 0 1 0 0 0 0 0 0
1 0 0 0 0 0 1 0 0 0 0 0

m = 3:  19 found :
1 1 1 0 0 0 0 0 0 0 0 0
1 1 0 1 0 0 0 0 0 0 0 0
1 0 1 1 0 0 0 0 0 0 0 0
1 1 0 0 1 0 0 0 0 0 0 0
1 0 1 0 1 0 0 0 0 0 0 0
1 0 0 1 1 0 0 0 0 0 0 0
1 1 0 0 0 1 0 0 0 0 0 0
1 0 1 0 0 1 0 0 0 0 0 0
1 0 0 1 0 1 0 0 0 0 0 0
1 0 0 0 1 1 0 0 0 0 0 0
1 1 0 0 0 0 1 0 0 0 0 0
1 0 1 0 0 0 1 0 0 0 0 0
1 0 0 1 0 0 1 0 0 0 0 0
1 0 0 0 1 0 1 0 0 0 0 0
1 0 0 0 0 1 1 0 0 0 0 0
1 0 1 0 0 0 0 1 0 0 0 0
1 0 0 1 0 0 0 1 0 0 0 0
1 0 0 0 1 0 0 1 0 0 0 0
1 0 0 0 1 0 0 0 1 0 0 0

m = 4:  43 found :
1 1 1 1 0 0 0 0 0 0 0 0
1 1 1 0 1 0 0 0 0 0 0 0
1 1 0 1 1 0 0 0 0 0 0 0
1 0 1 1 1 0 0 0 0 0 0 0
1 1 1 0 0 1 0 0 0 0 0 0
1 1 0 1 0 1 0 0 0 0 0 0
1 0 1 1 0 1 0 0 0 0 0 0
1 1 0 0 1 1 0 0 0 0 0 0
1 0 1 0 1 1 0 0 0 0 0 0
1 0 0 1 1 1 0 0 0 0 0 0
1 1 1 0 0 0 1 0 0 0 0 0
1 1 0 1 0 0 1 0 0 0 0 0
1 0 1 1 0 0 1 0 0 0 0 0
1 1 0 0 1 0 1 0 0 0 0 0
1 0 1 0 1 0 1 0 0 0 0 0
1 0 0 1 1 0 1 0 0 0 0 0
1 1 0 0 0 1 1 0 0 0 0 0
1 0 1 0 0 1 1 0 0 0 0 0
1 0 0 1 0 1 1 0 0 0 0 0
1 0 0 0 1 1 1 0 0 0 0 0
1 1 1 0 0 0 0 1 0 0 0 0
1 1 0 1 0 0 0 1 0 0 0 0
1 0 1 1 0 0 0 1 0 0 0 0
1 1 0 0 1 0 0 1 0 0 0 0
1 0 1 0 1 0 0 1 0 0 0 0
1 0 0 1 1 0 0 1 0 0 0 0
1 1 0 0 0 1 0 1 0 0 0 0
1 0 1 0 0 1 0 1 0 0 0 0
1 0 0 1 0 1 0 1 0 0 0 0
1 0 0 0 1 1 0 1 0 0 0 0
1 1 0 0 0 0 1 1 0 0 0 0
1 0 1 0 0 0 1 1 0 0 0 0
1 0 0 1 0 0 1 1 0 0 0 0
1 0 0 0 1 0 1 1 0 0 0 0
1 1 0 0 1 0 0 0 1 0 0 0
1 0 1 0 1 0 0 0 1 0 0 0
1 0 0 1 1 0 0 0 1 0 0 0
1 1 0 0 0 1 0 0 1 0 0 0
1 0 1 0 0 1 0 0 1 0 0 0
1 0 0 1 0 1 0 0 1 0 0 0
1 0 1 0 0 0 1 0 1 0 0 0
1 0 0 1 0 0 1 0 1 0 0 0
1 0 0 1 0 0 1 0 0 1 0 0

m = 5:  66 found :
1 1 1 1 1 0 0 0 0 0 0 0
1 1 1 1 0 1 0 0 0 0 0 0
1 1 1 0 1 1 0 0 0 0 0 0
1 1 0 1 1 1 0 0 0 0 0 0
1 0 1 1 1 1 0 0 0 0 0 0
1 1 1 1 0 0 1 0 0 0 0 0
1 1 1 0 1 0 1 0 0 0 0 0
1 1 0 1 1 0 1 0 0 0 0 0
1 0 1 1 1 0 1 0 0 0 0 0
1 1 1 0 0 1 1 0 0 0 0 0
1 1 0 1 0 1 1 0 0 0 0 0
1 0 1 1 0 1 1 0 0 0 0 0
1 1 0 0 1 1 1 0 0 0 0 0
1 0 1 0 1 1 1 0 0 0 0 0
1 0 0 1 1 1 1 0 0 0 0 0
1 1 1 1 0 0 0 1 0 0 0 0
1 1 1 0 1 0 0 1 0 0 0 0
1 1 0 1 1 0 0 1 0 0 0 0
1 0 1 1 1 0 0 1 0 0 0 0
1 1 1 0 0 1 0 1 0 0 0 0
1 1 0 1 0 1 0 1 0 0 0 0
1 0 1 1 0 1 0 1 0 0 0 0
1 1 0 0 1 1 0 1 0 0 0 0
1 0 1 0 1 1 0 1 0 0 0 0
1 0 0 1 1 1 0 1 0 0 0 0
1 1 1 0 0 0 1 1 0 0 0 0
1 1 0 1 0 0 1 1 0 0 0 0
1 0 1 1 0 0 1 1 0 0 0 0
1 1 0 0 1 0 1 1 0 0 0 0
1 0 1 0 1 0 1 1 0 0 0 0
1 0 0 1 1 0 1 1 0 0 0 0
1 1 0 0 0 1 1 1 0 0 0 0
1 0 1 0 0 1 1 1 0 0 0 0
1 0 0 1 0 1 1 1 0 0 0 0
1 0 0 0 1 1 1 1 0 0 0 0
1 1 1 0 1 0 0 0 1 0 0 0
1 1 0 1 1 0 0 0 1 0 0 0
1 0 1 1 1 0 0 0 1 0 0 0
1 1 1 0 0 1 0 0 1 0 0 0
1 1 0 1 0 1 0 0 1 0 0 0
1 0 1 1 0 1 0 0 1 0 0 0
1 1 0 0 1 1 0 0 1 0 0 0
1 0 1 0 1 1 0 0 1 0 0 0
1 0 0 1 1 1 0 0 1 0 0 0
1 1 1 0 0 0 1 0 1 0 0 0
1 1 0 1 0 0 1 0 1 0 0 0
1 0 1 1 0 0 1 0 1 0 0 0
1 1 0 0 1 0 1 0 1 0 0 0
1 0 1 0 1 0 1 0 1 0 0 0
1 0 0 1 1 0 1 0 1 0 0 0
1 1 0 0 0 1 1 0 1 0 0 0
1 0 1 0 0 1 1 0 1 0 0 0
1 0 0 1 0 1 1 0 1 0 0 0
1 0 1 1 0 0 0 1 1 0 0 0
1 1 0 0 1 0 0 1 1 0 0 0
1 0 1 0 1 0 0 1 1 0 0 0
1 0 0 1 1 0 0 1 1 0 0 0
1 0 1 0 0 1 0 1 1 0 0 0
1 0 0 1 0 1 0 1 1 0 0 0
1 0 0 1 0 0 1 1 1 0 0 0
1 1 0 1 0 0 1 0 0 1 0 0
1 0 1 1 0 0 1 0 0 1 0 0
1 1 0 0 1 0 1 0 0 1 0 0
1 0 1 0 1 0 1 0 0 1 0 0
1 0 1 0 0 1 1 0 0 1 0 0
1 0 1 0 1 0 0 1 0 1 0 0
 
Ja, ich habe einen Fehler entdeckt in meinem Prog. Die "Delete-Row" Anweisung funktioniert nicht immer. Irgendwie komme ich dem Fehler nicht bei?!?
 
Ich habe die Fehler eliminiert. Was jetzt noch interressant wäre herauszufinden:
wie sieht die Gesetzmäßigkeit aus! Gibt eine Folge a: N -> N (explizit/implizit), welche den
Sachverhalt beschreibt.Vielleicht ein "modifizierter" Binomialkoeffizient.
 

Ähnliche Themen

bundymania
[Bundymania User Review] K-GK 1 mechanische RGB Gaming Tastatur von KM-Gaming !
Antworten
0
Aufrufe
1K
bundymania
bundymania
heikosch
HTPC-Tastatur - Xebec Tech HTPC
Antworten
0
Aufrufe
14K
heikosch
heikosch
MusicIsMyLife
ASUS SABERTOOTH/GEN3 R2.0
Antworten
0
Aufrufe
42K
MusicIsMyLife
MusicIsMyLife
Dr@
Fujitsu STYLISTIC Q572 mit AMD Z-60 APU
Antworten
0
Aufrufe
52K
Dr@
Dr@
heikosch
AMDs Llano als Multimedia-Plattform
Antworten
0
Aufrufe
39K
heikosch
heikosch
Zurück
Oben Unten