Как распечатать все перестановки цифр?

[iks2]

Как распечатать все перестановки цифр?

Дано конкретное число 111222. Требуется распечатать все перестановки цифр этого числа. Очевидно, что это можно сделать и в уме. Но как это сделать если цифры будут иными? То есть нужна программа.
Мне не удалось решить эту задачу, но я решил другую, ей подобную, когда цифры не повторяются и предлагаю эту программу взять за основу. Впрочем если вы найдете иное, с вашей точки зрения более простое решение, то меня это устроит...

DECLARE SUB SWEP (i!, j!)
DECLARE SUB P (k!)
CLS

DIM SHARED n
DIM SHARED x AS STRING
x = "1234"
n = LEN(x)
CALL P(1)
END

SUB P (k)
   IF k = n THEN
      PRINT x
   ELSE
      FOR i = k TO n
         SWEP k, i
         CALL P(k + 1)
         SWEP k, i
      NEXT i
   END IF
END SUB

SUB SWEP (i, j)
   DIM a AS STRING
   DIM b AS STRING
   a = MID$(x, i, 1)
   b = MID$(x, j, 1)
   MID$(x, i, 1) = b
   MID$(x, j, 1) = a
END SUB

 

[iks2]

я нашел решение предложенной задачи, это решение не самое лучшее, но оно работает. Алгоритм состоит в том: итак мы имеем число 111222, если мы это число будем увеличивать на 1, то мы достигнем максимально возможного числа 222111. И если мы при этом будем откидывать все "лишние" числа, то у нас останутся лишь те, что содержат цифры 1 и 2 (по три раза). Эти числа программа и выносит на экран. Их в данном случае всего 20.

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

 

[AlexZir]

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

 

[iks2]

AlexZir,
Спасибо. Но в данном случае все-таки требуется выдать на экран все перестановки, а не считать их количество. Что то алгоритм мне не нравится. Наверняка должен быть более быстрый...