All Possible Number Outcomes, with Duplicates

CodeDing · ‎01-08-2019

Hello!

As I was working on THIS question, I came across an interesting function that I needed to complete this task.

I needed all possible number outcomes (combinations?) for a set of numbers and could not readily find this information.

Lee Mac has a Permutations function, but this didn't seem readily suitable for me.

So, I made my own and I just want to post it for users searching for something similar.

Here is some sample inputs / outputs

(BuildOutcomes 3 2 nil)
((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))

(BuildOutcomes 3 2 t)
((0 0) (0 1) (0 2) (0 3) (1 0) (1 1) (1 2) (1 3) (2 0) (2 1) (2 2) (2 3) (3 0) (3 1) (3 2) (3 3))

(BuildOutcomes 2 4 nil)
((1 1 1 1) (1 1 1 2) (1 1 2 1) (1 1 2 2) (1 2 1 1) (1 2 1 2) (1 2 2 1) (1 2 2 2)
(2 1 1 1) (2 1 1 2) (2 1 2 1) (2 1 2 2) (2 2 1 1) (2 2 1 2) (2 2 2 1) (2 2 2 2))

(BuildOutcomes 2 4 t)
((0 0 0 0) (0 0 0 1) (0 0 0 2) (0 0 1 0) (0 0 1 1) (0 0 1 2) (0 0 2 0) (0 0 2 1) (0 0 2 2)
(0 1 0 0) (0 1 0 1) (0 1 0 2) (0 1 1 0) (0 1 1 1) (0 1 1 2) (0 1 2 0) (0 1 2 1) (0 1 2 2)
(0 2 0 0) (0 2 0 1) (0 2 0 2) (0 2 1 0) (0 2 1 1) (0 2 1 2) (0 2 2 0) (0 2 2 1) (0 2 2 2)
(1 0 0 0) (1 0 0 1) (1 0 0 2) (1 0 1 0) (1 0 1 1) (1 0 1 2) (1 0 2 0) (1 0 2 1) (1 0 2 2)
(1 1 0 0) (1 1 0 1) (1 1 0 2) (1 1 1 0) (1 1 1 1) (1 1 1 2) (1 1 2 0) (1 1 2 1) (1 1 2 2)
(1 2 0 0) (1 2 0 1) (1 2 0 2) (1 2 1 0) (1 2 1 1) (1 2 1 2) (1 2 2 0) (1 2 2 1) (1 2 2 2)
(2 0 0 0) (2 0 0 1) (2 0 0 2) (2 0 1 0) (2 0 1 1) (2 0 1 2) (2 0 2 0) (2 0 2 1) (2 0 2 2)
(2 1 0 0) (2 1 0 1) (2 1 0 2) (2 1 1 0) (2 1 1 1) (2 1 1 2) (2 1 2 0) (2 1 2 1) (2 1 2 2)
(2 2 0 0) (2 2 0 1) (2 2 0 2) (2 2 1 0) (2 2 1 1) (2 2 1 2) (2 2 2 0) (2 2 2 1) (2 2 2 2))

...as you can see, these results can become quite exponential, so be cautious of the results you are expecting.

I am very much open to an alternative or reformed solution of my own function!

I hope this will benefit users in the future.

Best,

~DD

Source Code (with example call):

(defun c:TEST ( / lst n l a)
(initget 7) (setq n (getint "\nEnter High Number: "))
(initget 7) (setq l (getint "\nEnter List Length: "))
(initget 1 "Y N")
(setq a (cond ((getkword "\nInclude Zero [Y/N]<Y>: ")) ("Y")))
(if (eq "Y" (strcase a)) (setq a t) (setq a nil))
(setq lst (BuildOutcomes n l a))
(princ "\n.................") (princ lst) (princ "\n.................")
(princ)
);defun



(defun BuildOutcomes (highNumber listLength includeZero / tmp tmpL lst allreps stepcount repcount final)
;----------------------------------------------------------------------
;IN
;highNumber: Largest number that will be used in lists
;listLength: length of each list that will be storing outcomes of highNumber
;includeZero: t or nil, decides whether 0 will be used in outcomes or not
;OUT
;final: list that returns all possible outcomes for highNumber in lists that are "listLength" long for each outcome
;----------------------------------------------------------------------
(if includeZero (setq highNumber (1+ highNumber)))
(setq allreps (expt highNumber listLength))
(setq stepcount (/ allreps highNumber))
(setq repcount 0 final nil)
;(setq tmp '())
(repeat listLength
  (while (/= allreps repcount)
    (if includeZero (setq tmp 0) (setq tmp 1))
    (repeat highNumber
      (repeat stepcount
	(setq lst (reverse (cons (list tmp) (reverse lst))))
      );repeat
      (setq tmp (1+ tmp) repcount (+ repcount stepcount))
    );repeat
  );while
  (setq repcount 0 stepcount (/ stepcount highNumber))
  (if (not (null final))
    (progn
      	(setq tmp 0)
    	(repeat allreps
	  (setq tmpL (reverse (cons (append (nth tmp final) (nth tmp lst)) (reverse tmpL))))
	  (setq tmp (1+ tmp))
	);repeat
      	(setq final tmpL tmpL '())
    );progn
    	(setq final lst)
  );if
  (setq lst '())
);repeat
final
);defun

dlanorh · ‎01-08-2019

Not exactly the same, but whilst trying to "unkink" self overlapping polylines i needed to generate all possible paths a line could take through a number of points. The first and last points are always fixed, but you can step through a long polyline a sub-list of vertices at a time. Anyway I use these :

(defun displace (lst n)
  (if (> n 0)
	  (apply (function (lambda (x) (cons x (displace x (1- n))))) (list (append (cdr lst) (list (car lst)))))
  );end_if
);end_defun

(defun core (lst)
 (displace lst (length lst))
);end_defun

(defun sortout (lst)
  (if (cdr lst)
    (apply 'append (mapcar (function (lambda (x) (mapcar (function (lambda (y) (cons (car x) y))) (sortout (cdr x))))) (reverse (core lst)))) 
    (list lst)
  );end_if
);end_defun

(defun perms (n / lst s e cnt s_lst n_lst)
  (setq s 0 e (1- n) cnt e)
  (repeat (1- cnt)
    (setq lst (cons (setq cnt (1- cnt)) lst))
  );end_repeat	  
  (setq lst (sortout lst)
        cnt (length lst)
  );end_setq	
  (repeat cnt
    (setq s_lst (nth (setq cnt (1- cnt)) lst)
          s_lst (reverse (cons e (reverse s_lst)))
          s_lst (cons s s_lst)
          n_lst (cons s_lst n_lst)
    );end_setq
  );end_repeat  
);end_defun

The list is generated with this call

(setq perm_lst (perms n))

where n is the length of the sublist. Permutations for a sublist of 5 vertices would be

(setq perm_lst (perms 5))

==> ((0 1 2 3 4) (0 1 3 2 4) (0 3 1 2 4) (0 3 2 1 4) (0 2 3 1 4) (0 2 1 3 4))

I am not one of the robots you're looking for

marko_ribar · ‎01-08-2019

If I may say : permutations of 5 elements are list of 5! elements - so there are no 6 like you showed, but 120...

Correct me, I may be missing something I overlooked...

Marko Ribar, d.i.a. (graduated engineer of architecture)

Kent1Cooper · ‎01-08-2019

@marko_ribar wrote:

If I may say : permutations of 5 elements are list of 5! elements - so there are no 6 like you showed, but 120...

Correct me, I may be missing something I overlooked...

I think you missed that the first and last are always fixed [i.e. the result is only the permutations starting with 0 and ending with 4].

Kent Cooper, AIA

CodeDing · ‎01-08-2019

EDIT: Ignore

Kent1Cooper · ‎01-08-2019

@CodeDing wrote:

.... I needed all possible number outcomes (combinations?) for a set of numbers ....

I would word that differently -- all possible number sequences. For some purposes, the combination of [for example] 1 and 3 would be equivalent whether it's (1 3) or (3 1), i.e. those would be considered the same "combination" of numbers. Your routine obviously considers those to not be the same [presumably that's what "with Duplicates" means in the thread Title], so people should know that from it, different sequences or orders of the same combination of numbers are all returned separately. Obviously in some situations such as certain operations with Polyline vertices, the order matters, but in situations where the order doesn't matter, there are far fewer combinations from a given set of parameters -- for that, a different routine would be needed.

Kent Cooper, AIA

CodeDing · ‎01-08-2019

In my example call, this is incorrect...

(initget 1 "Y N")
(setq a (cond ((getkword "\nInclude Zero [Y/N]<Y>: ")) ("Y")))

It is preventing the default getkword as I intended and the "1" should be removed.

(initget "Y N")
(setq a (cond ((getkword "\nInclude Zero [Y/N]<Y>: ")) ("Y")))

Best,

~DD

CodeDing · ‎01-08-2019

@Kent1Cooper,

That is absolutely correct, thank you. As you can see I was struggling for the correct verbiage.

dlanorh · ‎01-08-2019

Hi Marco,
You are correct, but as I stated the first and last elements are fixed so in the case of a 5 element sublist only the middle three change so 3! = 6.

If an open polyline has 10 vertices you can step through them in groups of five. If the vertices need re-ordering, this is done after each sublist is completed and before the next group is extracted. e.g.

(1 2 3 4 5) @ (3 4 5 6 7) @ (6 7 8 9 10) @ => 18 ( 6 x 3) calculation instead of 40320 calculations (8!)
or
(1 2 3 4 5) @ (2 3 4 5 6) @ (3 4 5 6 7) @ (4 5 6 7 8) @ (5 6 7 8 9) @ (6 7 8 9 10) @ = 36 calculations instead of 40320
where @ = check returned order of list against sent order of list and if different reorder the main list

I suppose you could call it a quasi shortest route brute force by committee. It's not foolproof, and i wouldn't run it with a sublist length greater than 8. I ran it with a sublist length of 8 against a 240 vertex closed polyline; shifting the sublist start index by 1, and it took about 25 seconds to complete.

I am not one of the robots you're looking for

SanjoyNath · ‎01-09-2019

This is a good pain area for programmers

And Worthy also

I use this.I think you will like this(This has great power and can permute upto large number of characters)

https://www.gap-system.org/

Sanjoy Nath
BIM Manager And Digital Lead (Structures Online)
BOOST, AR , VR ,EPM,IFC API,PDF API , CAD API ,Revit API , Advance Steel API
Founder of Geometrifying Trigonometry(C)

SanjoyNath · ‎01-09-2019

Thank you Very Much @CodeDing

Your Code is helping me a lot in this project and your geometric permutation group for Geometrifying Trigonometry(C) Triangulation is amazing which gives proof tree completely with line segments(Not with Blocks), Handling single entities was very tough to do and you have done that with experts hands The Parse Tree is also Fantastic

My Colleague Debashis Bhunia also loves this subject and it is our project but since many other dependencies with Autocad 2007 level VBA we had to get this only through Block handling and so many advanced lisp commands are not available there he is still trying to handle that with

non permutations mode (using pure recursions)

Carry on @dbhunia

@dbhunia was on leave and he was struggling with his

Command is GeometrifyingTrigonometry [works on Layers PERPENDICULAR , BASE,HYPOTENUSE]

This is @dbhunia code

Now We were trying to run this code on 2007 where it runs but gives error

Same code (non permutation recursion fractal logic) is used

Code is here below and drawing is attached.It runs only for HB took 8 hours on Autocad 2017 for power = 20

Drawing attached is in 2007 versions and only power 7 is kept to set simple size

SanjoyNath(C)GeometrifyingTrigonometry(C)GeometrificationOfTrigonometry(C)GeometricProofOfTrigonometry(C)IntuitivePicturesOfGeometrifyingTrigonometryWorldHasNeverSeenThesePower7.png

(defun c:GBI (sel / HY BA PE) 
(vl-load-com)
(setq PT_lst nil)
(setq COB (vlax-invoke (vlax-ename->vla-object sel) 'explode))
   (foreach COBI COB
	(setq ent (entget (vlax-vla-object->ename COBI)))
	(if (and (= (cdr (assoc 0 ent)) "LINE") (= (cdr (assoc 8 ent)) "HYPOTENUSE"))
	    (setq HY (list (cdr (assoc 8 ent)) (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
	)
	(if (and (= (cdr (assoc 0 ent)) "LINE") (= (cdr (assoc 8 ent)) "BASE"))
	    (setq BA (list (cdr (assoc 8 ent)) (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
	)
	(if (and (= (cdr (assoc 0 ent)) "LINE") (= (cdr (assoc 8 ent)) "PERPENDICULAR"))
	    (setq PE (list (cdr (assoc 8 ent)) (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
	)
   )
(mapcar 'vla-delete COB)
(setq PT_lst (cons (list PE BA HY) PT_lst))
)
(defun c:INB ()
     (setq B1 (nth 1 (nth 1 (nth 0 PT_lst))) B2 (nth 2 (nth 1 (nth 0 PT_lst))))
     (command "insert" (cdr (assoc 2 (entget sel))) (nth 1 (nth 1 (nth 0 PT_lst))) "" "" "")
     (C:GBI (entlast))
     (setq IB1 (nth 1 (nth 2 (nth 0 PT_lst))) IB2 (nth 2 (nth 2 (nth 0 PT_lst)))) 
     (if (or (= N 1) (= N 3))
	   (progn (command "_.ALIGN" (entlast) "" IB1 B1 IB2 B2 "" "Y")
		  (if (= N 1) (command "_.MIRROR" (entlast) "" B1 B2 "Y"))
	   )
	   (progn (command "_.ALIGN" (entlast) "" IB1 B2 IB2 B1 "" "Y")
		  (if (= N 2) (command "_.MIRROR" (entlast) "" B1 B2 "Y"))
	   )
     )
)
(defun c:GeometrifyingTrigonometry()
(while (or (not (setq sel (car (entsel "\nSelect Triangle Block: "))))
	   (not (setq Pow (getreal "\nEnter Power: ")))
           (not (= (cdr (assoc 0 (entget sel))) "INSERT"))
       )
       (prompt "\nInvalid...")
)
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(C:GBI sel)
(vla-getBoundingBox (vlax-ename->vla-object sel) 'll 'ur)
(setq LL (vlax-safearray->list ll) UR (vlax-safearray->list ur) ISB LL)
(setq Off (* (distance LL UR) 2.0))
(setq IB (polar ISB (* pi 1.5) off))
(setq IB (list IB (polar IB 0 off) (polar IB 0 (* 2 off)) (polar IB 0 (* 3 off))))
(setq IB_lst nil)
(foreach PT IB	(command "copy" sel "" LL PT) (setq IB_lst (cons (list (entlast)) IB_lst)))

(setq NIB_lst nil)
(repeat (setq N (length IB_lst))
     (setq Ent_lst (nth (setq N (- N 1)) IB_lst))
     (C:GBI (setq PIB (nth (1- (length Ent_lst)) Ent_lst)))
     (C:INB)
     (setq NIB_lst (cons (list PIB (entlast)) NIB_lst))
)
(setq IB_lst NIB_lst)
(setq IB (nth 0 IB))
(setq Pow (- Pow 1) count 1)
(while (/= count Pow)
    (C:NTH) (setq count (+ count 1))
)
(setvar "cmdecho" 1)
(setvar "osmode" osm)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:NTH ()
(setq IB_lst_N nil)
(foreach B IB_lst
    (setq N 0)
    (setq B (reverse B))
    (setq IB (polar IB (* pi 1.5) off))
    (setq IBX (list IB (polar IB 0 off) (polar IB 0 (* 2 off)) (polar IB 0 (* 3 off))))
    (foreach PT IBX
	(setq add (ssadd))
    	(repeat (setq N1 (length B))
		(setq BE (nth (setq N1 (- N1 1)) B))
		(command "copy" BE "" LL PT) 
		(ssadd (entlast) add)
	)
     	(setq N (+ N 1))
     	(C:GBI (entlast))
     	(C:INB)
     	(ssadd (entlast) add)
	(setq aa nil)
	(repeat (setq i (sslength add))
		(setq e (ssname add (setq i (1- i))))
		(setq aa (cons e aa))
	)
	(setq IB_lst_N (cons aa IB_lst_N))
    )
)
(setq IB_lst IB_lst_N)
)

Sanjoy Nath
BIM Manager And Digital Lead (Structures Online)
BOOST, AR , VR ,EPM,IFC API,PDF API , CAD API ,Revit API , Advance Steel API
Founder of Geometrifying Trigonometry(C)

Community

All Possible Number Outcomes, with Duplicates

All Possible Number Outcomes, with Duplicates

All Possible Number Outcomes, with Duplicates