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

iks2 · 23.10.2016, 12:50

Дано конкретное число 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 · 25.10.2016, 13:33

я нашел решение предложенной задачи, это решение не самое лучшее, но оно работает. Алгоритм состоит в том: итак мы имеем число 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 · 25.10.2016, 15:22

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

iks2 · 25.10.2016, 15:47

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

23.10.2016, 12:50	#1 (permalink)
iks2 Member Регистрация: 22.10.2016 Сообщений: 62 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Как распечатать все перестановки цифр? Дано конкретное число 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

25.10.2016, 13:33	#2 (permalink)
iks2 Member Регистрация: 22.10.2016 Сообщений: 62 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	я нашел решение предложенной задачи, это решение не самое лучшее, но оно работает. Алгоритм состоит в том: итак мы имеем число 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

23.10.2016, 12:50
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Не отчаивайтесь если ответа нет, возможно эта тема уже обсуждалась ранее Как распечатать одну страницу как распечатать лист в клеточку Как распечатать чертеж в масштабе 1:10?

25.10.2016, 15:22	#3 (permalink)
AlexZir support Регистрация: 19.08.2007 Адрес: Зея Сообщений: 15,797 Записей в дневнике: 71 Сказал(а) спасибо: 166 Поблагодарили 203 раз(а) в 86 сообщениях Репутация: 75760	Есть формула дискретной математики, перестановка без повторения. Количество перестановок по ней можно определить.

25.10.2016, 15:47	#4 (permalink)
iks2 Member Регистрация: 22.10.2016 Сообщений: 62 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	AlexZir, Спасибо. Но в данном случае все-таки требуется выдать на экран все перестановки, а не считать их количество. Что то алгоритм мне не нравится. Наверняка должен быть более быстрый...

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070