Доброго всем дня! Решил создать генератор по комбинаторной задаче (перестановка с повторениями). Дело в том что формулами придти к итоговому результату так и не получилось. Нашел в инете код, правда он на C++ да и навыков у меня нет таких чтоб его переписать на VBA и по ходу его нужно допилить. Может кто поможет. Благодарю за понимание. [vba]
Код
#include <iostream> using namespace std; void swap(int *a, int i, int j) { int s = a[i]; a[i] = a[j]; a[j] = s; } bool NextSet(int *a, int n) { int j = n - 2; while (j != -1 && a[j] >= a[j + 1]) j--; if (j == -1) return false; // больше перестановок нет int k = n - 1; while (a[j] >= a[k]) k--; swap(a, j, k); int l = j + 1, r = n - 1; // сортируем оставшуюся часть последовательности while (l<r) swap(a, l++, r--); return true; } void Print(int *a, int n) // вывод перестановки { static int num = 1; // номер перестановки cout.width(3); // ширина поля вывода номера перестановки cout << num++ << ": "; for (int i = 0; i < n; i++) cout << a[i] << " "; cout << endl; } int main() { int n, *a; cout << "N = "; cin >> n; a = new int[n]; for (int i = 0; i < n; i++) a[i] = i + 1; a[1] = 1; // повторяющийся элемент Print(a, n); while (NextSet(a, n)) Print(a, n); cin.get(); cin.get(); return 0; }
[/vba]
Доброго всем дня! Решил создать генератор по комбинаторной задаче (перестановка с повторениями). Дело в том что формулами придти к итоговому результату так и не получилось. Нашел в инете код, правда он на C++ да и навыков у меня нет таких чтоб его переписать на VBA и по ходу его нужно допилить. Может кто поможет. Благодарю за понимание. [vba]
Код
#include <iostream> using namespace std; void swap(int *a, int i, int j) { int s = a[i]; a[i] = a[j]; a[j] = s; } bool NextSet(int *a, int n) { int j = n - 2; while (j != -1 && a[j] >= a[j + 1]) j--; if (j == -1) return false; // больше перестановок нет int k = n - 1; while (a[j] >= a[k]) k--; swap(a, j, k); int l = j + 1, r = n - 1; // сортируем оставшуюся часть последовательности while (l<r) swap(a, l++, r--); return true; } void Print(int *a, int n) // вывод перестановки { static int num = 1; // номер перестановки cout.width(3); // ширина поля вывода номера перестановки cout << num++ << ": "; for (int i = 0; i < n; i++) cout << a[i] << " "; cout << endl; } int main() { int n, *a; cout << "N = "; cin >> n; a = new int[n]; for (int i = 0; i < n; i++) a[i] = i + 1; a[1] = 1; // повторяющийся элемент Print(a, n); while (NextSet(a, n)) Print(a, n); cin.get(); cin.get(); return 0; }
' 1>;LH5 ?5@5AB0=>2>: =5B Dim k As Integer = (n - 1)
While (a(j) >= a(k)) k = (k - 1)
End While
swap(a, j, k) Dim r As Integer = (n - 1) Dim l As Integer = (j + 1) ' A>@B8@C5< >AB02HCNAO G0ABL ?>A;54>20B5;L=>AB8
While (l < r) swap(a, l++, r--)
End While
Return true End Function
Private Sub Print(ByVal a As Integer, ByVal n As Integer) Dim num As Integer = 1 ' =><5@ ?5@5AB0=>2:8 cout.width(3) ' H8@8=0 ?>;O 2K2>40 =><5@0 ?5@5AB0=>2:8 (cout + num) = ((cout + num) _ + 1) ": " Dim i As Integer = 0 Do While (i < n) (cout _ + (a(i) + " ")) i = (i + 1) Loop
(cout + endl) End Sub
Private Function main() As Integer Dim Star As Integer Dim n As Integer a (cout + "N = ") (cin + n) a = New Integer((n) - 1) {} Dim i As Integer = 0 Do While (i < n) a(i) = (i + 1) i = (i + 1) Loop
a(1) = 1 ' ?>2B>@ONI89AO M;5<5=B Print(a, n)
While NextSet(a, n) Print(a, n)
End While
cin.get cin.get Return 0 End Function
[/vba]
Попробовал конвертер с C++ на VBA и вот что получил. [vba]
Код
# include Imports namespace std
Private Sub swap(ByVal a As Integer, ByVal i As Integer, ByVal j As Integer) Dim s As Integer = a(i) a(i) = a(j) a(j) = s End Sub
Private Function NextSet(ByVal a As Integer, ByVal n As Integer) As Boolean Dim j As Integer = (n - 2)
' 1>;LH5 ?5@5AB0=>2>: =5B Dim k As Integer = (n - 1)
While (a(j) >= a(k)) k = (k - 1)
End While
swap(a, j, k) Dim r As Integer = (n - 1) Dim l As Integer = (j + 1) ' A>@B8@C5< >AB02HCNAO G0ABL ?>A;54>20B5;L=>AB8
While (l < r) swap(a, l++, r--)
End While
Return true End Function
Private Sub Print(ByVal a As Integer, ByVal n As Integer) Dim num As Integer = 1 ' =><5@ ?5@5AB0=>2:8 cout.width(3) ' H8@8=0 ?>;O 2K2>40 =><5@0 ?5@5AB0=>2:8 (cout + num) = ((cout + num) _ + 1) ": " Dim i As Integer = 0 Do While (i < n) (cout _ + (a(i) + " ")) i = (i + 1) Loop
(cout + endl) End Sub
Private Function main() As Integer Dim Star As Integer Dim n As Integer a (cout + "N = ") (cin + n) a = New Integer((n) - 1) {} Dim i As Integer = 0 Do While (i < n) a(i) = (i + 1) i = (i + 1) Loop
поясните подробнее, что именно нужно, на небольшом примере (из 3-4 чисел)
Вот как раз смотрел Ваши наработки, там есть перестановки, но они без повторений, а у меня задача перестановки с повторениями. И нигде не могу найти такой генератор. Перестановка нужна 3-ёх чисел, но каждое число может повторяться. Массив до 15-ти. Т.е нужны всевозможные варианты перестановок. Пример массива из 6-ти символов: 1: 112233 2: 221133 3: 332211 4: 113322 5: 331122 6: 223311 7: 123123 8: 321321 9: 231231 10: 321321 и т.д... (в данном примере, всевозможных перестановок будет 90 вариантов). Благодарю за понимание!
поясните подробнее, что именно нужно, на небольшом примере (из 3-4 чисел)
Вот как раз смотрел Ваши наработки, там есть перестановки, но они без повторений, а у меня задача перестановки с повторениями. И нигде не могу найти такой генератор. Перестановка нужна 3-ёх чисел, но каждое число может повторяться. Массив до 15-ти. Т.е нужны всевозможные варианты перестановок. Пример массива из 6-ти символов: 1: 112233 2: 221133 3: 332211 4: 113322 5: 331122 6: 223311 7: 123123 8: 321321 9: 231231 10: 321321 и т.д... (в данном примере, всевозможных перестановок будет 90 вариантов). Благодарю за понимание!Кузьмич
как понял (см. вложение) К сообщению приложен файл: Perm.xlsm(17Kb)
Вы меня правильно поняли что я имел ввиду. Очень признателен, что хоть кто то откликнулся на мою проблему! Проверил, работает идеально!!! Слава великим ГУРУ!!!
как понял (см. вложение) К сообщению приложен файл: Perm.xlsm(17Kb)
Вы меня правильно поняли что я имел ввиду. Очень признателен, что хоть кто то откликнулся на мою проблему! Проверил, работает идеально!!! Слава великим ГУРУ!!!Кузьмич