Распределение камней - QBasic

Формулировка задачи:

Есть камни весом 1, 2, 3, 4, 5, 6, 7, 8, 9 целых единиц. Их нужно разложить по трем рюкзакам одинаково по весу, все рюкзаки должны иметь одинаковый вес. При этом, в 1м рюкзаке - 2 камня, во 2м - 3 камня, в 3м - 4 камня. Нужно определить, сколько существует таких вариантов разложения и перечислить их. Решение напрашивается только перебором.

Спойлер

Решение задачи: «Распределение камней»

textual
                            Листинг программы 
                        

                            DECLARE FUNCTION MyNarayanaNextPerm(n AS LONG) AS LONG
 
DIM SHARED pArr(1 TO 9) AS LONG
DIM i AS LONG, n AS LONG, m AS LONG, a(1 TO 9) AS LONG, s(1 TO 3) AS LONG, t(1 TO 3) AS STRING
n = 9 'количество камней
m = 3 'количество рюкзаков
FOR i = 1 TO n: READ a(i): NEXT i 'чтение весов камней
FOR i = 1 TO n: READ pArr(i): NEXT i 'чтение начальной расстановки
 
DO
    FOR i = 1 TO m
        s(i) = 0 'сумма в рюкзаке
        t(i) = "" 'содержание рюкзака
    NEXT i
    FOR i = 1 TO n
        s(pArr(i)) = s(pArr(i)) + a(i) 'считаем сумму в рюкзаках
        t(pArr(i)) = t(pArr(i)) + "+" + LTRIM$(STR$(a(i))) 'формируем состав рюкзака
    NEXT i
 
    FOR i = 2 TO m 'проверка на равенство веса во всех рюкзаках
        IF s(1) <> s(i) THEN GOTO NextDo 'суммы не совпадают, к следующей перестановке
    NEXT i 
    FOR i = 1 TO m 'если вес во всех рюкзаках одинаковый, то выводим решение
        PRINT MID$(t(i), 2),
    NEXT i
    PRINT
NextDo:
LOOP WHILE MyNarayanaNextPerm(n)
SLEEP
DATA 1, 2, 3, 4, 5, 6, 7, 8, 9
DATA 1, 1, 2, 2, 2, 3, 3, 3, 3
 
FUNCTION MyNarayanaNextPerm(n AS LONG) AS LONG
    DIM i AS LONG, k AS LONG, t AS LONG
    FOR k = n - 1 TO 1 STEP -1
        IF pArr(k) < pArr(k + 1) THEN EXIT FOR
    NEXT k
    IF k THEN
        t = n
        WHILE t > k AND pArr(k) >= pArr(t)
            t = t - 1
        WEND
        SWAP pArr(k), pArr(t)
        t = n
        FOR i = k + 1 TO (n + k) \ 2
            SWAP pArr(i), pArr(t)
            t = t - 1
        NEXT i
        MyNarayanaNextPerm = i
    END IF
END FUNCTION
                        