Все перестановки числа 111222 - QBasic

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

Число 111222 можно рассматривать как двоичное И чтобы получить все перестановки - надо к этому числу "прибавлять" 1 по правилу. 1+1=2, 2+1=11. До тех пор, пока не получится число 222111. Кроме того надо проверять чтобы число единичек равнялось число двоек. Эта программа делает как сказано выше (проверено)

                    Листинг программы
                
 
                        
                          
                    
REM 111222
 
DECLARE FUNCTION SUM$ (x$)
DECLARE FUNCTION f! (s1$, s2$)
CLS
DIM n  AS STRING
DIM n1 AS STRING
DIM n2 AS STRING
 
n1 = "111222"
n2 = "222111"
PRINT n1
 
DO
   n = SUM(n1)
   IF f(n, (n2)) THEN PRINT n
   n1 = n
LOOP UNTIL n = n2
END
 
FUNCTION f (s1 AS STRING, s2 AS STRING)
   DIM s AS STRING
 
   FOR i = 1 TO LEN(s1)
      s = MID$(s1, i, 1)
      k = INSTR(s2, s)
      IF k THEN MID$(s2, k, 1) = " "
   NEXT i
 
   s = LTRIM$(s2)
   IF s = "" THEN f = -1 ELSE f = 0
END FUNCTION
 
FUNCTION SUM$ (x AS STRING)
   DIM s AS STRING
 
   FOR i = LEN(x) TO 1 STEP -1
      s = MID$(x, i, 1)
      IF s = "2" THEN
         MID$(x, i, 1) = "1"
         GOTO 100
      ELSE
         MID$(x, i, 1) = "2"
         SUM = x
         EXIT FUNCTION
      END IF
100
   NEXT
END FUNCTION

Решение задачи: «Все перестановки числа 111222»

textual
                            Листинг программы 
                        
 
                        
                          
                    
DECLARE FUNCTION MyNarayanaNextPerm(n AS LONG) AS LONG
DATA 1,1,1,2,2,2
 
DIM SHARED prmArr(1 TO 6) AS LONG
DIM n AS LONG, i AS LONG
  
n = 6
 
FOR i=1 TO n
    READ prmArr(i)
NEXT i
 
DO
    FOR i = 1 TO n
        PRINT prmArr(i);
    NEXT
    PRINT
LOOP WHILE MyNarayanaNextPerm(n)
'Sleep
    
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 prmArr(k) < prmArr(k + 1) THEN EXIT FOR
    NEXT k
    IF k THEN
        t = n
        WHILE t > k AND prmArr(k) >= prmArr(t)
        t = t - 1
        WEND
        SWAP prmArr(k), prmArr(t)
        t = n
        FOR i = k + 1 TO (n + k) \ 2
           SWAP prmArr(i), prmArr(t)
           t = t - 1
        NEXT i
        MyNarayanaNextPerm = i
    END IF
END FUNCTION