Комбинаторика и переборные алгоритмы

Что такое комбинаторика?

Вам наверняка встречались такие задачи, в которых нужно найти количество способов, которыми можно расположить некоторые предметы, сделать действие и т.д. Именно такие задачи и решает комбинаторика.

Основные понятия комбинаторики - перестановка, размещение и сочетание. Также на важном месте находится факториал.

Факториал

n! (n факториал) - это произведение всех натуральных чисел от 1 до n (n! = 1 * 2 * 3 * ... * n).

Условились считать, что 0! = 1! = 1.

Факториал вычисляется очень легко:

Пример 1

Private Function fact (ByVal n As Integer) As Double
       Dim i As Integer

       Fact = 1
       For i = 1 To n 'перемножаем все числа от 1 до n
           fact = fact * i
       Next
End Function

Факториал можно также вычислить с помощью рекурсивного алгоритма:

Пример 2

Private Function fact (ByVal n As Integer) As Double
       If n <= 0 Then 'проверяем условие выхода из рекурсии
           fact = 1
       Else
           fact = num * fact (n - 1) 'перемножаем промежуточный результат и на единицу меньшее число
       End If
End Function

Заметьте, что возвращаемое значение должно иметь тип Double. Это сделано, потому что факториал растёт очень быстро и уже 13! не умещается в рамки типа Long. Тип Double позволяет вычислять факториалы чисел до 170.

Лучше использовать нерекурсивный алгоритм вычисления факториала, так как этот способ быстрее и при использовании рекурсии возможно переполнение стека.

Последовательности

Предположим, нам нужно вывести в Textbox все последовательности длины N из чисел 1, 2, 3, ..., M. Первая последовательность будет иметь следующий вид:

1, 1, 1, ..., 1

, а последняя:

M, M, M, ..., M.

Всего таких последовательностей будет M ^ N.

Пусть последовательность находится в одномерном массиве X. Создадим процедуру NextS, которая будет генерировать последовательность. Её нужно будет вызвать M ^ N раз. В процедуре NextS нужно перебрать все N знаков последовательности, начиная с последнего. Если знак равен M, то присваиваем ему значение 1, в ином случае увеличиваем его на единицу и выходим из цикла.

Пример 3

Dim M As Integer
Dim N As Integer
Dim X() As Integer

Private Sub Sequences()
Dim i As Integer
Dim j As Integer

M = CInt (InputBox ("Введите M"))
N = CInt (InputBox ("Введите N"))
ReDim X(N)

txtOut.Text = ""

For i = 1 To N
       X(i) = 1
Next
Yes = False
For i = 1 To M ^ N
       For j = 1 To N
txtOut.Text = txtOut.Text & CStr(X(j))
       Next
       txtOut.Text = txtOut.Text & vbCrLf
       NextS
Next
End Sub

Private Sub NextS()
Dim i As Integer

i = N
Do While (i > 0) And (X(i) = M)
X(i) = 1
i = i - 1
Loop
If i > 0 Then (i) = X(i) + 1
End Sub

Все последовательности можно найти также и рекурсивным алгоритмом:

Пример 4

Dim M As Integer
Dim N As Integer
Dim X() As Integer

Private Sub SequencesRecursion()
M = 5
N = 5
ReDim X(N)

txtOut.Text = ""

SRGenerate 0
End Sub

Private Sub SRGenerate (ByVal K As Integer)
Dim i As Integer
Dim j As Integer

If K = N Then
For i = 1 To N
txtOut.Text = txtOut.Text & CStr(X(i))
Next
txtOut.Text = txtOut.Text & vbCrLf
Else
For j = 1 To M
X(K + 1) = j
SRGenerate (K + 1)
Next
End If
End Sub

Перестановки

Число перестановок - это число различных способов, которыми можно упорядочить данное множество, состоящее из n элементов.

Число перестановок n элементов равно n!. Его можно вычислить следующим образом:

Пример 5

Private Function PereCount (ByVal n As Integer) As Double
       PereCount = fact (n)
End Function

Private Function fact (ByVal n As Integer) As Double
       Dim i As Integer

       Fact = 1
       For i = 1 To n 'перемножаем все числа от 1 до n
           fact = fact * i
       Next
End Function

Предположим, нам нужно вывести в TextBox все перестановки чисел от 1 до N. Создадим для этого рекурсивный алгоритм, который будет выглядеть так:

Пример 6

Dim N As Integer
Dim X () As Integer

Private Sub Perestanovki ()
     Dim i As Integer

     N = CInt (InputBox ("Введите N"))
     ReDim X (N)
     For i = 1 To N
         X (i) = i
     Next
     PRGenerate 0
End Sub

Private Sub PRGenerate (ByVal k As Integer)
     Dim i As Integer

     If k = N Then
         For i = 1 To N
           txtOut.Text = txtOut.Text & CStr (X (i))
         Next
         txtOut.Text = txtOut.Text & vbCrLf
     Else
         For i = k + 1 To N
           Swap X (k + 1), X (i)
           PRGenerate k + 1
           Swap X (k + 1), X (i)
         Next
     End If
End Sub

Private Sub Swap (ByRef a As Integer, ByRef b As Integer)
     Dim c As Integer

     c = a
     a = b
     b = c
End Sub

Сочетания

Сочетание - это произвольное k-элементное подмножество n-элементного множества. Порядок элементов в подмножестве не имеет значения.

Пример сочетаний по 2 из 3:

Число сочетаний находится по следующей формуле:

Число сочетаний можно вычислить, используя следующий код:

Пример 7

Private Function SochCount (ByVal n As Integer, ByVal k As Integer) As Double
       SochCount = fact (n) / (fact (k) * fact (n-k))
End Function

Private Function fact (ByVal n As Integer) As Double
       Dim i As Integer

       Fact = 1
       For i = 1 To n 'перемножаем все числа от 1 до n
           fact = fact * i
       Next
End Function

Есть и другой способ вычисления количества сочетаний. Его Вы можете использовать, если n! или k! не умещаются в рамках типа Double (если n>170 или k>170). Этот способ заключается в использовании треугольника Паскаля (он же арифметический треугольник, он же золотой треугольник).

В 1653 году Блез Паскаль опубликовал "Трактат об арифметическом треугольнике". Этот треугольник был известен ещё в Древней Индии (X век). В XVI веке он был вновь открыт Штифелем.

Треугольник Паскаля строится очень легко. Его бёдра и вершина состоят из единиц, а остальные элементы получаются сложением двух элементов, стоящих непосредственно над ним. Количество сочетаний будет равным элементу k треугольника, находящемуся в строке n. n и k нумеруются от нуля.

Алгоритм вычисления числа сочетаний с использованием треугольника Паскаля представлен ниже:

Пример 8

Private Function SochTT (ByVal n As Integer, ByVal k As Integer) As Double
       Dim i As Integer
       Dim j As Integer
       Dim TT () As Double

       ReDim TT (n, k)
       For i = 0 To n
         TT (0, i) = 1
         TT (i, i) = 1
       Next
       For i = 2 To n
         For j = 1 To i - 1
           TT (i, j) = TT (i - 1, j - 1) + TT (i - 1, j)
         Next
       Next
       SochTT = TT (n, k)
End Function

Если Вам нужно вычислять число сочетаний много раз, то, возможно, будет удобнее один раз построить треугольник Паскаля, а затем получать из массива данные.

Пример 9

Dim TT () As Double

Private Sub CreateTT ()
      ReDim TT (0, 0)
      BuildTT 0, 0
End Sub

Private Function SochTT (ByVal n As Integer, ByVal k As Integer) As Double
      If n > Ubound (TT) Then BuildTT Ubound (TT) + 1, n
      SochTT = TT (n, k)
End Function

Private Sub TerminateTT ()
      ReDim TT (0, 0)
End Sub

Private Sub BuildTT (ByVal start As Integer, ByVal end As Integer)
      Dim i As Integer
      Dim j As Integer

      ReDim Preserve TT (end, end)
      For i = start To end
         TT (0, i) = 1
         TT (i, i) = 1
      Next
      If end < 2 Then Exit Sub
      If start < 2 Then start = 2
      For i = start To end
         For j = 1 To i - 1
           TT (i, j) = TT (i - 1, j - 1) + TT (i - 1, j)
         Next
      Next
End Sub

Сначала нужно вызвать процедуру CreateTT. Затем Вы можете получать число сочетаний с помощью функции SochTT. Когда треугольник станет Вам не нужен, вызовите процедуру TerminateTT. В вышеуказанном коде при вызове функции SochTT, если треугольник ещё не достроен до необходимого уровня, то он достраивается с помощью процедуры BuildTT. Затем функция получает нужный элемент массива TT и возвращает его.

Допустим, нам нужно вывести в TextBox все сочетания из N по K. Создадим для этого рекурсивный алгоритм, который будет выглядеть так:

Пример 10

Dim X () As Integer
Dim Counter () As Integer
Dim K As Integer
Dim N As Integer

Public Sub Soch()
Dim i As Integer

N = CInt(InputBox("Введите N"))
K = CInt(InputBox("Введите K"))

K = K + 1

ReDim X(N)

For i = 1 To N
      X(i) = i
Next
txtOut.Text = ""

ReDim Counter(K)
Counter(0) = 1

SochGenerate 1
End Sub

Private Sub SochGenerate(ByVal c As Integer)
Dim i As Integer
Dim j As Integer
Dim n1 As Integer
Dim Out() As Integer
Dim X1() As Integer

    If c = K Then
      ReDim Out(K)

      X1 = X

      For i = 1 To K - 1
         n1 = 0
         For j = 1 To N
           If X1(j) <> 0 Then n1 = n1 + 1
           If n1 = Counter(i) Then
             Out(i) = X1(j)
             X1(j) = 0
             Exit For
           End If
         Next
         txtOut.Text = txtOut.Text & CStr(Out(i))
      Next
      txtOut.Text = txtOut.Text & vbCrLf
    Else
      For Counter(c) = Counter(c - 1) To N - c + 1
         SochGenerate c + 1
      Next
    End If
End Sub

Размещения

Размещение - это произвольное k-элементное подмножество n-элементного множества. Порядок элементов в подмножестве имеет значение.

Пример размещений из 3 по 2:

Число размещений находится по формуле:

A (n, k) =

Число размещений можно вычислить, используя такой код:

Пример 11

Private Function RazmCount (ByVal n As Integer, ByVal k As Integer) As Double
     RazmCount = fact (n) / fact (n - k)
End Function

Private Function fact (ByVal n As Integer) As Double
     Dim i As Integer

     Fact = 1
     For i = 1 To n 'перемножаем все числа от 1 до n
       fact = fact * i
     Next
End Function

Допустим, нам нужно вывести в TextBox все размещения из N по K. Это можно сделать очень легко. Размещения - это все перестановки всех сочетаний. Мы уже знаем, как найти все сочетания и все перестановки. Создадим алгоритм нахождения всех размещений:

Пример 12

Dim X () As Integer
Dim Counter () As Integer
Dim Out() As Integer
Dim K As Integer
Dim N As Integer

Private Sub Razm ()
Dim i As Integer

N = CInt(InputBox("Введите N"))
K = CInt(InputBox("Введите K"))

K = K + 1

ReDim X(N)
   ReDim Out(K)

For i = 1 To N
     X(i) = i
Next
txtOut.Text = ""

ReDim Counter(K)
Counter(0) = 1

RazmSochGenerate 1
End Sub

Private Sub RazmSochGenerate ()
Dim i As Integer
Dim j As Integer
Dim n1 As Integer
Dim X1() As Integer

   If c = K Then

     X1 = X

     For i = 1 To K - 1
       n1 = 0
       For j = 1 To N
         If X1(j) <> 0 Then n1 = n1 + 1
         If n1 = Counter(i) Then
           Out(i) = X1(j)
           X1(j) = 0
           Exit For
         End If
       Next
     Next
     PRGenerate 0
   Else
     For Counter(c) = Counter(c - 1) To N - c + 1
       RazmSochGenerate c + 1
     Next
   End If
End Sub

Private Sub PRGenerate (ByVal k As Integer)
   Dim i As Integer

   If k = N Then
     For i = 1 To N
       txtOut.Text = txtOut.Text & CStr (Out (i))
     Next
     txtOut.Text = txtOut.Text & vbCrLf
   Else
     For i = k + 1 To N
       Swap Out (k + 1), Out (i)
       PRGenerate k + 1
       Swap Out (k + 1), Out (i)
     Next
   End If
End Sub

Private Sub Swap (ByRef a As Integer, ByRef b As Integer)
   Dim c As Integer

   c = a
   a = b
   b = c
End Sub