get all combinations

Nigel_Garvey · October 8, 2014, 10:41am

Hi Shane.

Your assumption’s party right. As you probably noticed, my first ASObjC script (post #13) is just a revamp of my right-to-left vanilla script from post #10, with ObjC arrays and methods used instead of vanilla where there are more than two items.

In the vanilla scripts, the script-object-within-a-handler idea offers three advantages (to my way of thinking):

The script object’s properties can be “referenced” to allow faster access to the vanilla list items.
The recursive part of the only-partially recursive process can be contained within the main handler.
The lists and the precalculated r and m values can be held in local properties instead of having to be passed or recalculated with each recursion or held in globals or global properties outside the main handler.

Point 1, as you say, doesn’t apply with the ObjC arrays. Point 2 is a largely a matter of my own personal preference. Point 3 is connected with point 2, but is also relevant with regard to the amount of work the script has to do. Your rewrite passes two extra parameters AND recalculates r and m on every call to the recursive handler. I’d therefore expect it to be a little slower than my script. And it is, on my machine. With nine items, it’s taking about six seconds longer than mine this morning. But mine’s taking a fair bit longer than it did yesterday, so the difference between the scripts’ times may actually be less under optimal conditions.

Now that’s interesting! But the difference is far less dramatic for me. 117 seconds as opposed to 134 (this morning). Still, that’s a lot more than I’d have expected until you mentioned it.

Shane_Stanley · October 8, 2014, 10:54am

Yes, I found it a bit slower here too, although I got a bit excited when I accidentally left a number off the initial list

That coercion time is the killer. I found when I wrote ASObjC Runner that with even modest lists of lists, virtually all the time was taken converting AS stuff to Cocoa and vice-versa; the work performed was almost irrelevant most of the time. One of the advantages of having ASObjC everywhere is that it makes it easier to do the conversions only when you need to.

DJ_Bazzie_Wazzie · October 8, 2014, 1:16pm

Exactly! Nigel’s code took 45 seconds on my MBP when an AppleScript list is returned but when I return a pointer to the NSMutableArray it took only 40 seconds. That means that AppleScriptObjC bridge will take up to 5 seconds to coerce to a NSMutableArray containing 362,880 items into an AppleScript list. That fits right with my OSAX “problem” because when thinking about it, the AEPutParamDesc does an extra copy of the object meaning it will take two times 5 seconds (and probably some more copying when the event is handled by the event manager).

McUsrII · October 8, 2014, 1:38pm

It’s getting nicer and nicer.

But . if you make a list of 362,880, I have to assume that you are going to use that list for something other than just generating it, and then, those 10 seconds, won’t take up that much time proportionally. You can for all I know, execute an Osascript in the background, from a do shell script for all I know.

I have another approach, I generate permutations, or combinations on the fly, paying a penalty with each invocation, I live well with that, at least until I have timed it, because I have a practical need for testing if vectors in matrix are orthogonal to each other, by testing them accordingly to generated combinations. If a test fails, then I must start over from scratch. So I pay a penalty in total time, but saves some time per invocation, and some memory too! I have no idea how I would create a list with 362880 items in Applescript however. Have the boundaries changed?

There are however a lot of things lists with permutations and combinations that are generated up front can be used for. Today I have understood how mikerickson’s algorithm for generating permutations with repeats works, it is pretty clever I think.

This is really a great thread.

DJ_Bazzie_Wazzie · October 8, 2014, 2:25pm

AppleScript allows lists up to 2^31 items, well at least in theory. Because the maximum allowed index is the maximum value of a signed 32-bit integer and negative indexes are not allowed. To create a list with 362880 items, there is no problem you just have to wait 20+ seconds.

McUsrII · October 8, 2014, 3:22pm

Hello DJ.

Thanks for enlightening me, I was dead sure anything above 2^14 was futile.

20 seconds isn’t a long time, except for when in front of a computer!

McUsrII · October 8, 2014, 7:14pm

Hello.

For those interested, here is a generator of r-combinations. There is nothing wrong with Daehls, I just wanted something simpler to understand as the problem intrigued me, so this is probably slower. I found the pseudo code in a buggy! :mad: pdf document somwhere. (Daehls delist handler is something that seems to be a great way to translate items into indicies IMO.)

set comboList to {}
combination(comboList, 3, 6)
listprint(comboList)
(* 
"{1, 2, 3}
{1, 2, 4}
{1, 2, 5}
{1, 2, 6}
{1, 3, 4}
{1, 3, 5}
{1, 3, 6}
{1, 4, 5}
{1, 4, 6}
{1, 5, 6}
{2, 3, 4}
{2, 3, 5}
{2, 3, 6}
{2, 4, 5}
{2, 4, 6}
{2, 5, 6}
{3, 4, 5}
{3, 4, 6}
{3, 5, 6}
{4, 5, 6}"
*)
on combination(combinations, r, n)
	# print the first r combination
	set S to {}
	repeat with i from 1 to r
		set end of S to i
	end repeat
	copy S to end of combinations
	
	repeat with i from 2 to C(n, r)
		set m to r
		set max_val to n
		
		repeat while (((item m) of S) = max_val)
			set m to m - 1
			set max_val to max_val - 1
		end repeat
		# increment the above rightmost element
		set item m of S to (item m of S) + 1
		# all others are the successors: 
		
		repeat with j from (m + 1) to r
			set item j of S to (item (j - 1) of S) + 1
		end repeat
		copy S to end of combinations
	end repeat
end combination


on listprint(theL)
	try
		text 0 of theL
	on error e
		set ofs to offset of "{" in e
		set tmp to text (ofs + 1) thru -3 of e
		tell (a reference to text item delimiters)
			set astid to contents of it
			set contents of it to "}, "
			set newl to text items of tmp
			set contents of it to "}" & return
			set newt to newl as text
			set contents of it to astid
		end tell
		return newt
	end try
end listprint


on C(n, r)
	# Counts the number of r-combinations in a set of n elements.
	# it is also called the binomial coeffecient.
	if n = 0 or n < r or r < 0 then error "C: argument error"
	return (factorial(n) div (factorial(r) * (factorial(n - r))))
end C


on factorial(n)
	if n > 170 then error "Factorial: n too large."
	# Result greater than 1.797693E+308!
	if n < 0 then error "Factorial: n not positive."
	set a to 1
	repeat with i from 1 to n
		set a to a * i
	end repeat
	return a
end factorial

Edit
Made a “fancier” listprint handler.

McUsrII · October 9, 2014, 12:42am

Hello.

I have made a handler for generating combinations with repetitions, for completion, since we then have all kinds of handlers here. You’ll have to allow for every element being chosen as many times as there are rooms in your subset.

set comboList to {}

set donuts to {"iced", "jam", "plain", "something completely different"}
set chosen to {0, 0, 0, 0}
# the number of items in the list chosen, must coincide with the n_chosen parameter.

choose(comboList, chosen, 1, 4, 1, 3)
--> 15 (combinations

listprint(comboList)
(*
"{\"iced\", \"iced\", \"iced\", \"iced\"}
{\"iced\", \"iced\", \"iced\", \"jam\"}
{\"iced\", \"iced\", \"iced\", \"plain\"}
{\"iced\", \"iced\", \"jam\", \"jam\"}
{\"iced\", \"iced\", \"jam\", \"plain\"}
{\"iced\", \"iced\", \"plain\", \"plain\"}
{\"iced\", \"jam\", \"jam\", \"jam\"}
{\"iced\", \"jam\", \"jam\", \"plain\"}
{\"iced\", \"jam\", \"plain\", \"plain\"}
{\"iced\", \"plain\", \"plain\", \"plain\"}
{\"jam\", \"jam\", \"jam\", \"jam\"}
{\"jam\", \"jam\", \"jam\", \"plain\"}
{\"jam\", \"jam\", \"plain\", \"plain\"}
{\"jam\", \"plain\", \"plain\", \"plain\"}
{\"plain\", \"plain\", \"plain\", \"plain\"}"

*)

(*

The calculation for the number of combinations with repetitions are:

C( maxtypes+n_chosen-1,n_chosen) or C(n+r-1,r) with other variable names.

*)

log C(3 + 4 - 1, 4)

--> 15



on choose(combinations, got, n_chosen, len, atw, maxtypes)
	global donuts
	
	set tcount to 0
	
	if n_chosen = (len + 1) then
		# log "n_chosen = len "
		if got = 0 then return 1
		set lineout to {}
		repeat with i from 1 to len
			set end of lineout to item (item i of got) of donuts
		end repeat
		copy lineout to end of combinations
		return 1
	end if
	
	repeat with i from atw to maxtypes
		if (got â‰  0) then
			set item n_chosen of got to i
			set tcount to tcount + choose(combinations, got, (n_chosen + 1), len, i, maxtypes)
		end if
	end repeat
	return tcount
	
end choose

on listprint(theL)
	try
		text 0 of theL
	on error e
		set ofs to offset of "{" in e
		set tmp to text (ofs + 1) thru -3 of e
		tell (a reference to text item delimiters)
			set astid to contents of it
			set contents of it to "}, "
			set newl to text items of tmp
			set contents of it to "}" & return
			set newt to newl as text
			set contents of it to astid
		end tell
		return newt
	end try
end listprint

on C(n, r)
	# Counts the number of r-combinations in a set of n elements.
	# it is also called the binomial coeffecient.
	if n = 0 or n < r or r < 0 then error "C: argument error"
	return (factorial(n) div (factorial(r) * (factorial(n - r))))
end C


on factorial(n)
	if n > 170 then error "Factorial: n too large."
	# Result greater than 1.797693E+308!
	if n < 0 then error "Factorial: n not positive."
	set a to 1
	repeat with i from 1 to n
		set a to a * i
	end repeat
	return a
end factorial

Nigel_Garvey · October 9, 2014, 2:55pm

Here’s an interesting one.

By means of concatenation, this vanilla version of my script prebuilds a list of the required length to hold the permutations. When used as a Library in exactly the same way as the ASObjC version in post #13, it executes in a mere 5 seconds or so as opposed to the ASObjC version’s 134 seconds! However, with both versions, it then takes nearly two and a half minutes to do anything with the result, such as setting a variable to it or getting its class!

on allPermutations(theList)
	
	script o
		property workList : missing value
		property permutations : {}
		property r : count theList -- index of the rightmost item of workList.
		property m : r - 1 -- index of the middle item of the last three of workList.
		property p : 1 -- index into the permutations list.
		
		on prmt(l)
			-- l is the index of the leftmost item affected by this iteration
			set n to r - l + 1 -- n is the number of list items affected by this iteration (l thru r)
			
			if (n is 3) then
				-- These six permutations are hard-coded to reduce low-level recursion
				copy my workList to item p of my permutations
				
				set {v1, v2, v3} to items l thru r of my workList
				
				set item m of my workList to v3
				set item r of my workList to v2
				copy my workList to item (p + 1) of my permutations
				
				set item l of my workList to v2
				set item r of my workList to v1
				copy my workList to item (p + 2) of my permutations
				
				set item m of my workList to v1
				set item r of my workList to v3
				copy my workList to item (p + 3) of my permutations
				
				set item l of my workList to v3
				set item r of my workList to v2
				copy my workList to item (p + 4) of my permutations
				
				set item m of my workList to v2
				set item r of my workList to v1
				copy my workList to item (p + 5) of my permutations
				
				set my p to p + 6
			else
				-- Precalculate some values for the repeat
				set lPlus1 to l + 1 -- parameter for next-level recursions
				set nIsEven to (n mod 2 = 0) -- true if n is even
				set x to r -- the default index with which to swap if n is odd
				
				-- Get all permutations of items (l +1) thru r with the current item l
				prmt(lPlus1)
				-- Repeat with successive values of item l
				repeat with i from r to lPlus1 by -1
					-- If n is even, swap items l and i, otherwise default to swapping items l and r
					if (nIsEven) then set x to i
					tell item x of my workList
						set item x of my workList to item l of my workList
						set item l of my workList to it
					end tell
					prmt(lPlus1)
				end repeat
			end if
		end prmt
		
	end script
	
	if (o's r < 3) then
		-- Special-case lists of less than three items
		copy theList to the beginning of o's permutations
		if (o's r is 2) then set the end of o's permutations to the reverse of theList
	else
		-- Otherwise use the recursive handler
		copy theList to o's workList
		-- Prebuild a list of the required length (factorial of theList's length) to hold the permutations.
		set mv to missing value
		set mvList to {mv, mv, mv, mv, mv, mv} -- Minimum length is 6 with a 3-item input list.
		set mvList2 to mvList
		repeat with i from 3 to (o's r) - 1
			repeat i times
				set mvList2 to mvList2 & mvList
			end repeat
			set mvList to mvList2
		end repeat
		set o's permutations to mvList
		o's prmt(1)
	end if
	
	return o's permutations
	
end allPermutations

McUsrII · October 9, 2014, 5:36pm

Hello.

Your handlers are as eminent as well always. I guess you just stay with AsobjC, when time is precarious enough.

I figure that the data, the permuations are used for, are maybe less demanding with regards to copying them in, a little at a time from vanilla Applescript.

It is very comforting to know that such handlers exists, DJ’s handler from that other thread is also a nice one, for practical purposes. This is such a great and fun thread!

Shane_Stanley · October 9, 2014, 11:45pm

I’m not sure what you’re timing, but yes, most stuff would be much quicker if we didn’t have to await results

Nigel_Garvey · October 10, 2014, 12:42pm

It’s the time taken to execute the permutations code with a nine-item input list versus the time taken to execute the code and set a variable to the result. The difference is about two to two-and-a-half minutes! The same’s true for getting information from the result, such as its class or the value of one of its items.

Here’s the timing script I’ve been using in AppleScript Editor. Only the timing result appears in the Result pane, so the time it would take to decompile all the permutations for display isn’t a factor:

use permuter : script "Permuter 4" -- The vanilla script in post #49.
use scripting additions

----------
-- "Timer.scpt" is a script on my own computer. The current script won't work without it (or a similar one).
tell me to set timer to (load script file ((path to scripts folder from user domain as text) & "Libraries:Timer.scpt"))
tell timer to StartTimer()
----------
permuter's allPermutations({1, 2, 3, 4, 5, 6, 7, 8, 9}) -- Timed code.
----------
tell timer to set t to readTimer()
----------
(*
Sample results this morning vary between 4.964 and 6.342 seconds.
But changing the timed code to:
set l to permuter's allPermutations({1, 2, 3, 4, 5, 6, 7, 8, 9})
--> 120.436 to 132.929 seconds.
*)

The situation’s similar when timing the ASObjC version, but with longer times:

use permuter : script "Permuter 3" -- The ASObjC script in post #13.
use scripting additions

----------
-- "Timer.scpt" is a script on my own computer. The current script won't work without it (or a similar one).
tell me to set timer to (load script file ((path to scripts folder from user domain as text) & "Libraries:Timer.scpt"))
tell timer to StartTimer()
----------
permuter's allPermutations({1, 2, 3, 4, 5, 6, 7, 8, 9}) -- Timed code.
----------
tell timer to set t to readTimer()
----------
(*
Sample results this morning vary between 131.031 and 137.428 seconds.
But changing the timed code to:
set l to permuter's allPermutations({1, 2, 3, 4, 5, 6, 7, 8, 9})
--> 257.602 to 260.286 seconds.
*)

Shane_Stanley · October 10, 2014, 10:53pm

Interesting.

Let me add a few comments about ASObjC and this thread. One of the reasons I was initially reluctant to bother with an ASObjC version is that I didn’t think it would offer any advantage. And ultimately it didn’t, except by bending the test in its favor with very large lists – so large, they are probably practically unusable in AS.

Where ASObjC is likely to offer real speed gains, I think, is in cases where it can replace algorithms. Things like using a sort method, or using classes like sets to make lists unique. Although this might look a bit like cheating, and at times be downright dull, I think it’s very much in the spirit of AppleScript and things like the whose clause: real speed gains are generally made by pushing the work out to be done somewhere else. And while we’re all happy to see clever algorithms implemented in Nigel’s hands, less code means less chance for bugs.

McUsrII · October 11, 2014, 6:49pm

Hello.

I felt that an r-permutation with repeats was missing here, that is permutations with r elements, from a set of n elements, with repeating elements.

There isn’t much to say about the implementation, other than that it works like an odometer basically. If we make permutations with a size of r elements, over a set of n elements, with repeats, then we must generate n^r combinations.

I have also left out zero as a valid element, and I intend to use this with daehls delist handler, for translating back and forth.

set thePerms to {}

r_permute_reps(3, 5, thePerms)
listprint(thePerms)
(*
"{1, 1}
{1, 2}
{1, 3}
{1, 4}
{1, 5}
{2, 1}
{2, 2}
{2, 3}
{2, 4}
{2, 5}
{3, 1}
{3, 2}
{3, 3}
{3, 4}
{3, 5}
{4, 1}
{4, 2}
{4, 3}
{4, 4}
{4, 5}
{5, 1}
{5, 2}
{5, 3}
{5, 4}
{5, 5}"
*)
on r_permute_reps(n, r, perm_list)
	
	set oldperm to {}
	repeat with i from 1 to r
		-- initialize oldperm
		set end of oldperm to 1
	end repeat
	copy oldperm to end of perm_list
	repeat with i from 1 to (n ^ r - 1)
		if ((item r) of oldperm < n) then
			set (item r) of oldperm to ((item r) of oldperm) + 1
		else
			set (item r) of oldperm to 1
			repeat with j from (r - 1) to 1 by -1
				if item j of oldperm < n then
					set item j of oldperm to (item j of oldperm) + 1
					exit repeat
				else
					set item j of oldperm to 1
				end if
			end repeat
		end if
		copy oldperm to end of perm_list
		
	end repeat
end r_permute_reps

on listprint(theL)
	try
		text 0 of theL
	on error e
		set ofs to offset of "{" in e
		set tmp to text (ofs + 1) thru -3 of e
		tell (a reference to text item delimiters)
			set astid to contents of it
			set contents of it to "}, "
			set newl to text items of tmp
			set contents of it to "}" & return
			set newt to newl as text
			set contents of it to astid
		end tell
		return newt
	end try
end listprint

Edit

Added some code that was forgotten so it works for r’s >2.

McUsrII · May 7, 2015, 11:05am

Hello.

Here is yet another handler, this time one that returns the powerset of a set. A power set, is the combination of all sets that can be made from the original set.

I have used handlers that I have posted earlier in this thread, and included them here, so it works as it is is posted.

 
on factorial(n)
	if n > 170 then error "Factorial: n too large."
	# Result greater than 1.797693E+308!
	if n < 0 then error "Factorial: n not positive."
	set a to 1
	repeat with i from 1 to n
		set a to a * i
	end repeat
	return a
end factorial

on c(n, r)
	# Counts the number of r-combinations in a set of n elements.
	# it is also called the binomial coeffecient.
	if n = 0 or n < r or r < 0 then error "C: argument error"
	return (factorial(n) div (factorial(r) * (factorial(n - r))))
end c

on combination(combinations, r, n)
	# print the first r combination
	set s to {}
	repeat with i from 1 to r
		set end of s to i
	end repeat
	copy s to end of combinations
	
	repeat with i from 2 to my c(n, r)
		set m to r
		set max_val to n
		
		repeat while (((item m) of s) = max_val)
			set m to m - 1
			set max_val to max_val - 1
		end repeat
		# increment the above rightmost element
		set item m of s to (item m of s) + 1
		# all others are the successors: 
		
		repeat with j from (m + 1) to r
			set item j of s to (item (j - 1) of s) + 1
		end repeat
		copy s to end of combinations
	end repeat
end combination

on createPowerSet from origSet
	-- assumes the set is made up of consecutive integers, starting at 1.
	-- i.e. {1,2,3} is a valid set, {2,5,6} is not. You may make your own mapping of sorts, of course.
	-- Number of sets in the powerset is 2 ^(length of origset)
	set powSet to {origSet}
	set origLen to (length of origSet)
	repeat with i from (origLen - 1) to 1 by -1
		combination(powSet, i, origLen)
	end repeat
	set end of powSet to {}
	return powSet
end createPowerSet


createPowerSet from {1, 2, 3}
-- {{1, 2, 3}, {1, 2}, {1, 3}, {2, 3}, {1}, {2}, {3}, {}}

technomorph · August 21, 2018, 2:42pm

could you decode the above characters?

â‰¥
â‰¤

thanks

Nigel_Garvey · August 21, 2018, 4:23pm

Sorry. They’re due to a change in MacScripter’s BBS software a year or two ago.

What gets the same results as daehl is to change â‰¥ to ≥ (greater than or equal to) and â‰¤ to ≤ (less than or equal to).