/* --- Copyright University of Sussex 2003. All rights reserved. ---------- > File: $poplocal/local/lib/permutations.p > Purpose: Generate permutations of elements of a structure > Author: David Young, Jan 5 2003 (see revisions) > Documentation: HELP * PERMUTATIONS */ /* See the help file for what this library does. Some extra notes follow; more details are in the code. Algorithm --------- A list-based strategy is adopted. The recursive structure is shown most clearly by the following Prolog definition: permutation([], []). permutation(L1, [A|L2]) :- delete(A, L1, L3), permutation(L3, L2). where delete(A, P, Q) succeeds if A deleted from P leaves Q. The algorithm used here is what the definition above generates under the usual Prolog execution model. An alternative implementation ----------------------------- The following Pop-11 code is equivalent to the present library, except with respect to time and storage, in the order in which the results are generated, and in only accepting lists as input. It is included as an example of how mixed-language programming can offer a concise solution to a problem. uses ploginpop prolog_compile(stringin(' \ delete(A, [A|L], L). \ delete(A, [X|L1], [X|L2]) :- delete(A, L1, L2). \ permutation([], []). \ permutation(L1, [A|L2]) :- delete(A, L1, L3), permutation(L3, L2). \ ')); define perm_list(l) /* -> rep */; lvars p, plog_perm_list = |< permutation(^l, ?p) >|; lconstant expired = mishap(% 0, 'Calling expired permutation repeater' %); procedure /* -> perm */; if plog_perm_list() then p else expired -> plog_perm_list; termin endif endprocedure enddefine; The code below is more complex in order to provide greater speed and create less garbage, and perhaps also to avoid having to load the Prolog subsystem. It also allows a variety of data structures to be used. Implementation notes -------------------- The main issue in an efficient implementation is generating lists with selected elements deleted. Normally deleting an element of a list involves building a new list, at least up to the point of the deletion, but this would be slow and make a lot of garbage. Here, an element is deleted by fixing the pointer from the previous element to bypass it. This process damages the original list and so has to be carefully reversed. Whilst it is tempting to create the bridge when making the recursive call, and restore the list on return, this is inefficient. In fact, provided the list is private to the repeaters, the bridge need only be created when the element A to be deleted is selected, and the links restored when A is unselected. To allow the real first element to be deleted in this way, the list is passed around with a dummy first element. The concatenation of the deleted element A and the permutation of the remainder L2 is done on the stack, so that the results can be put straight into the required structure. An implementation that closely shadowed the Prolog template might create a new repeater for each shortened list. Since this would involve building new repeaters during permutation generation, it is not done here. Instead, the repeaters reset themselves after terminating, so simulating the creation of a new repeater the next time they are called. The basic program is speeded up considerably by using tables of permutations of integers. For short lists, instead of using the procedure above, the repeater cycles through the relevant table and uses the current permutation of integers as indices into the data structure it is starting from. This applies not only to short initial data structures, but also to the final few levels of the recursion for longer data structures, so all cases go faster. The required tables are built using the basic procedure and any existing tables, and the number of stored tables can be adjusted at any stage. */ compile_mode:pop11 +strict; section; ;;; The next two lines are for the lookup table code - see the end of ;;; the program for how they are used. NTABLES can be changed to any ;;; positive integer, but increasing it to more than about 8 will ;;; increase compilation time significantly and use a lot of memory. lconstant NTABLES = 6; ;;; The initial number of lookup tables lvars lookup_tables = {}; ;;; The vector of lookup tables define lconstant perm_list(list, len) /* -> listrep */; ;;; Creates a repeater to permute the elements of a list. ;;; Arguments: ;;; list - the dummy first pair of the list ;;; len - the length that the list will appear to be ;;; when the repeater is called ;;; Result: ;;; a procedure of no arguments that returns either ;;; to indicate that no more permutations are available ;;; or to indicate that a permutation of the list ;;; elements has been placed on the stack ;;; Fast procedures are used - these are OK because the wrapper ;;; has checked that we are getting a list. ;;; The next few variables hold values for lexical closures ;;; of the subprocedures. ;;; lc points to the current list element, whose contents are c ;;; lp and ln point to the previous and next list elements ;;; nextrep holds the procedure for getting permutations of the ;;; shortened list ;;; i is the number of the current permutation for the table-based ;;; procedure lvars lp, lc=false, ln, c, procedure nextrep, i=false; define :inline lconstant getset; ;;; Initialise the list pointers to the start of the list ;;; and bridge the (real) first element list -> lp; ;;; dummy first element fast_back(lp) -> lc; ;;; true start fast_destpair(lc) -> (c, ln); ;;; second element, current val ln -> fast_back(lp); ;;; bridge to omit lc enddefine; define :inline lconstant moveon; ;;; Shift the pointers and the bridge one place along the list lc ->> fast_back(lp) ;;; restore list to include old lc -> lp; ;;; shift lp ln -> lc; ;;; shift lc fast_destpair(lc) -> (c, ln); ;;; shift ln, get current val ln -> fast_back(lp); ;;; bridge list to omit new lc enddefine; define :inline lconstant reset; ;;; Restore the list to normal lc -> fast_back(lp); false -> lc; ;;; no current contents enddefine; define lconstant perm_rep_list /* -> (p, c, result) */; ;;; The core of the process described above. unless lc then ;;; new repeater at this level? getset(); ;;; yes, initialise nextrep() -> /* p */; ;;; bound to succeed, discard boolean elseif nextrep() then ;;; another perm at current position? /* no operation */ ;;; yes - p is on the stack elseunless ln == [] then ;;; nextrep failed - new position? moveon(); ;;; get next element at this level nextrep() -> /* p */; ;;; bound to succeed else ;;; nextrep failed, and at end reset(); ;;; restore link, unset lc, return(false) ;;; and signal failure endunless; c, true /* -> (c, result) */ ;;; put c on stack, signal success enddefine; define lconstant perm_rep_null /* -> result */; ;;; Handles the special case of the empty list not(lc) ->> lc /* -> result */ enddefine; define lconstant perm_rep_lookup(table, vec, n) /* -> result */; ;;; This is not necessary - it is only to provide a speedup by ;;; doing table lookup if tables are available. ;;; The inputs are table, a vector of vectors, each a ;;; permutation of the integers from 1 to the length of the ;;; input, vec a work vector, and n the number of permutations. unless i then ;;; starting a new repeater - initialise explode(fast_back(list)) -> explode(vec); 0 -> i endunless; i fi_+ 1 -> i; if i fi_> n then ;;; have completed the cycle - no more perms false ->> i /* -> result */ ;;; restart next time else lvars ind; fast_for ind in_vector fast_subscrv(i, table) do fast_subscrv(ind, vec) ;;; order data using table endfor; ;;; and leave on stack true /* -> result */ endif enddefine; ;;; Return closures of subprocedures if len == 0 then ;;; null list perm_rep_null /* -> listrep */ elseif len <= length(lookup_tables) then ;;; lookup available lvars tbl = lookup_tables(len); ;;; ordinary frozvals for speed perm_rep_lookup(% tbl, initv(len), length(tbl) %) /* -> listrep */ else perm_list(list, len-1) -> nextrep; perm_rep_list /* -> listrep */ endif enddefine; define permutations(struct) /* -> rep */; ;;; Wrapper for perm_list - handles other data structures by the ;;; simple expedient of exploding them and building lists. ;;; Even if struct is a list, it must be rebuilt so that the link ;;; bridging does not leave the original in a bad state between ;;; calls to the repeater. lvars newstruct = true; ;;; Get option argument if struct.isboolean then struct -> (struct, newstruct) endif; lvars list = [% 0, explode(struct) %], ;;; always need to build new list procedure listrep = perm_list(list, length(list)-1), procedure copymaybe; ;;; may need to copy struct if newstruct then ;;; get correct copier if struct.islist then copylist ;;; copydata goes too deep else copy endif else identfn endif -> copymaybe; define lconstant perm_rep -> result; lconstant complete_err = 'Calling expired permutation repeater'; if listrep() then ;;; perm on stack if successful copymaybe(struct) -> result; -> explode(result); ;;; fill from stack (lists handled OK) else termin -> result; ;;; replace false with termin mishap(% 0, complete_err %) -> listrep ;;; available as garbage endif enddefine; perm_rep /* -> rep */ enddefine; /* The basic program is now complete - what follows can be omitted without loss of function (along with perm_rep_lookup). However, it is easy to build lookup tables to speed things up substantially. These are built below using the existing program. Initially, the number built is NTABLES, set at the top, but the global active variable may be updated at any time to change the number used. */ define lconstant perm_table(n) /* -> table */; ;;; Make a single lookup table. This is a vector of vectors, each ;;; a different permutation of the integers from 1 to n. lvars i, p; {% for p from_repeater permutations({% for i from 1 to n do i endfor %}) do p endfor %} enddefine; define active permutation_tables; length(lookup_tables) enddefine; define updaterof active permutation_tables(n); checkinteger(n, 0, false); lvars i; if n < permutation_tables then ;;; throw away tables {% for i from 1 to n do ;;; - storage can be garbage lookup_tables(i) ;;; collected endfor %} -> lookup_tables else ;;; Build new tables. The vector of lookup tables is updated ;;; incrementally so that each table made speeds up creation ;;; of the next. for i from permutation_tables+1 to n do {% explode(lookup_tables), perm_table(i) %} -> lookup_tables endfor endif enddefine; NTABLES -> permutation_tables; ;;; Set up some tables initially endsection; /* --- Revision History --------------------------------------------------- --- David Young, Jan 7 2003 Added table lookup. --- David Young, Jan 6 2003 Fixed bug (lconstant dummy initial pair), improved efficiency by doing list bridging and unbridging only when needed, tidied up. */