Random assignment of elements in a list - algorithm

I have a list (of N ALISTs) that I need to partition into k mutually exclusive, collectively exhaustive lists (that don't necessarily have to be the same length). That is, I need a function that will do something like the following (for N = 6, k = 2):
(my-function (listA listB listC listD listE listF))
#=> ((listA listC listF listD) (listB listE))
The approach I was thinking about goes along those lines (assigning a number up to k for each member of the ALIST and then grouping those items based on their assignment). Maybe it's stupid, I'm not sure.
(defun make-solution (problem)
"Generates random initial solution to be later explored"
(let ((assignments (mapcar #'(lambda (request) (random *fleet-size*)) problem)))
; maybe something to group back the elements of problem according to their value in assignments?
))
Any hints on what to fill in? Maybe a better approach? For context, what I'm doing is randomly creating an initial population for a vehicle routing problem that I can later iterate on with my local search.

Something like this maybe:
CL-USER 39 > (pprint
(let ((l (loop for i from 1 upto 100 collect i)))
(flet ((part (l k &aux (r (make-array k :initial-element nil)))
(loop while l
do (push (pop l) (aref r (random k))))
(coerce r 'list)))
(part l 7))))
((98 94 89 87 85 84 78 71 68 53 42 38 35 33 27 26 5 3)
(93 86 65 55 54 37 23 18 11 10 2)
(92 91 82 69 67 62 61 59 56 52 44 36 34 22 21 12 7)
(97 77 76 70 57 47 46 45 43 32 17 14 4)
(96 95 90 88 83 81 80 73 58 49 48 39 30 25 19 8 6)
(75 63 60 41 31 24 15 9 1)
(100 99 79 74 72 66 64 51 50 40 29 28 20 16 13))
Preserve the order:
CL-USER 40 > (pprint
(let ((l (loop for i from 1 upto 100 collect i)))
(flet ((part (l k &aux (r (make-array k :initial-element nil)))
(loop while l
do (push (pop l) (aref r (random k))))
(map 'list #'reverse r)))
(part l 7))))
((6 13 14 22 24 40 44 55 57 58 64 66 67 74 78 92 95 96)
(7 11 23 26 27 28 81 91)
(3 5 8 9 10 20 21 33 35 36 42 45 47 63 69 72 75 80 88 89 98)
(2 16 32 43 53 68 71 76 79 84 87 90 93 94 97)
(1 4 12 15 18 25 30 39 41 46 48 51 54 59 65 73 83 100)
(17 19 29 31 34 37 38 49 56 85 86)
(50 52 60 61 62 70 77 82 99))

Related

Is there a way to sum pairwise in Octave, vectorized (ie. mapping and reducing matrices)?

Is there a way to sum pairwise in Octave?
If for example, I have a 10-row by 4 column. I want a new 10 row by 2 column, where each column is the sum of the pairs.
ex.
[ 1 2 3 4
2 3 4 5
...
]
=> [ 3 7
5 9
...
]
I know how to accomplish this using for loops and accumarray etc, but I'm just not sure if there's a way to do it that is completely vectorized.
Here are a few more options.
Given:
a = reshape(1:40, 10, 4)
a =
1 11 21 31
2 12 22 32
3 13 23 33
4 14 24 34
5 15 25 35
6 16 26 36
7 17 27 37
8 18 28 38
9 19 29 39
10 20 30 40
Keep it simple
b = [sum(a(:,1:2),2) sum(a(:,3:4),2)]
b =
12 52
14 54
16 56
18 58
20 60
22 62
24 64
26 66
28 68
30 70
Squeeze a little
b = squeeze(sum(reshape(a, [], 2, 2), 2))
b =
12 52
14 54
16 56
18 58
20 60
22 62
24 64
26 66
28 68
30 70
Or, my personal favorite...
Mathemagic
b = a * [1 1 0 0; 0 0 1 1].'
b =
12 52
14 54
16 56
18 58
20 60
22 62
24 64
26 66
28 68
30 70
Perhaps someone comes with a better idea:
a = [1 2 3 4; 2 3 4 5]
b = reshape (sum (reshape (a.', 2, [])), [], rows(a)).'
gives
b =
3 7
5 9

FInd location of element in a vector

I'm new to APL and I would like to find the position of an element(s) within a vector. For example, if I create a vector of 50 random numbers:
lst ← 50 ? 100
How can I find the positions of 91 assuming it occurs 3 times in the vector?
Thanks.
I'm not an expert, but a simple way is to just select the elements from ⍳ 100 where the corresponding element in lst is 91
(lst=91)/⍳100
With Dyalog 16.0, you can use the new monadic function ⍸ "Where".
⍸lst=91
lst=91 gives a vector of 0s and 1s. Applying ⍸ on this gives the locations of all the 1s. This also works if lst is a matrix.
Thanks to ngn, Cows_quack and Probie. I should have read Mastering Dyalog APL more carefully as it also mentions this on page 126. So taking all the answers together:
⍝ Generate a list of 100 non-unique random numbers
lst ← ?100⍴100
⍝ How many times does 1, for example, appear in the vector Using the compress function?
+/ (lst = 1) ⍝ Appears twice
2
⍝ Find the locations of 1 in the vector
(lst = 1) / ⍳ ⍴ lst
2 37 ⍝ Positions 2 and 37
So to break down the solution; (i) (lst = 1) generates a boolean vector where true occurs where the int value of 1 exists; (ii) compress the lst vector by the boolean vector creates a new vector with the positions of 'true' in lst.
Correct me if my description is off?
SIMPLIFICATION:
Using the 'Where' function makes it more readable (though the previous method shows how the APL mindset of array programming is used to solve it):
⍸lst=1
2 37 ⍝ Positions 2 and 37
Thanks for your time on this!
Regards
While your question has already been amply answered, you may be interested in the Key operator, ⌸. When its derived function is applied monadically, it takes a single operand and applies it once for each element in the argument. The function is called with the unique element as left argument and the list of its indices as right argument:
lst ← ?100⍴10
{⍺ ⍵}⌸lst
┌──┬──────────────────────────────────────────┐
│3 │1 3 9 28 37 38 55 70 88 │
├──┼──────────────────────────────────────────┤
│10│2 6 13 17 30 59 64 66 71 82 83 96 │
├──┼──────────────────────────────────────────┤
│7 │4 5 12 15 20 52 54 68 74 85 89 91 92 │
├──┼──────────────────────────────────────────┤
│9 │7 11 24 47 53 58 69 86 90 │
├──┼──────────────────────────────────────────┤
│8 │8 14 16 21 43 51 63 67 73 80 │
├──┼──────────────────────────────────────────┤
│2 │10 18 26 27 34 36 48 78 79 87 │
├──┼──────────────────────────────────────────┤
│1 │19 25 31 32 33 42 57 65 75 84 97 98 99 100│
├──┼──────────────────────────────────────────┤
│6 │22 23 45 46 50 60 76 94 │
├──┼──────────────────────────────────────────┤
│5 │29 49 56 61 72 77 93 95 │
├──┼──────────────────────────────────────────┤
│4 │35 39 40 41 44 62 81 │
└──┴──────────────────────────────────────────┘
Try it online!

How to divide N numbers into N/2 groups (2 numbers each group) such that the sum of diffrence between the 2 numbers in each group is minmal?

General Problem Description
Hi, it is actually a special assignment problem( check wiki if interested). Suppose I have 10 agents denoted as A1, A2, ... A10 and I need them to work in pairs. While, according to previous experience, I know the working efficiency of each two-agent pair so that I have an efficiency matrix shown as follows whose ( i, j ) element represents the working efficiency of agent pair ( Ai, Aj ). Hence, we know it should be a symmetric matrix, which means E( i, j )=E( j, i ) and E( i, i ) should be 0. Now, I need divide these 10 agents into 5 groups such that the overall (sum) efficiency is maximal.
E =
0 25 28 23 39 77 56 58 85 41
25 0 18 77 32 52 69 59 47 18
28 18 0 20 55 75 63 38 5 56
23 77 20 0 59 76 24 82 68 64
39 32 55 59 0 49 70 28 42 31
77 52 75 76 49 0 33 84 50 29
56 69 63 24 70 33 0 15 49 83
58 59 38 82 28 84 15 0 68 40
85 47 5 68 42 50 49 68 0 56
41 18 56 64 31 29 83 40 56 0
N.B.
From the matrix view of this problem, I need pick 5 elements from above matrix such that none of them share a same index with others. ( if you pick E( 2, 3 ), then you cannot pick any elments with index containing 2 or 3 since A2 and A3 are assigned to work. In other words, you cannot pick any elements from the 2nd, 3rd row and 2nd, 3rd column.)
The title of this problem is an equivalent problem to the special assignment problem mentinoned above.
You may find the Hungarian(munkres) algorithm helpful! Here is the matlab code.
Another view of this problem is to solve a normal assignment problem, but we need to find a solution whose elements are symmetrically distributed about the diagonal.
Directly applying Hungarian(munkres) algorithm to the symmetric efficiency matrix does not always work. Sometimes it will give asymmetric permutations e.g.
E =
0 30 63 32 20 40
30 0 67 84 75 63
63 67 0 37 79 88
32 84 37 0 43 59
20 75 79 43 0 56
40 63 88 59 56 0
The optimal solution is:
assignment =
0 0 0 0 0 1
0 0 0 1 0 0
1 0 0 0 0 0
0 1 0 0 0 0
0 0 1 0 0 0
0 0 0 0 1 0
This can be solved as weighted maximum matching problem, where:
G = (V,E,w)
V = { all numbers }
E = { (v,u) | v,u in V, v!=u }
w(u,v) = -|u-v|
The solution to maximum matching will pair all your vertices (numbers), such that sum of: sum { -|u-v| : u,v paired } is maximum, which means sum { |u-v| : u,v paired is minimum.

Selecting the "P" in Prune and Search Algorithm

Note: the diagram above shows a partition into groups of 5 (the columns). The horizontal box denotes the median values of each partition. The 'P' item indicates the median of medians.
Most of the researches that I saw have this picture in Selecting their "P" and it always have an odd numbers of elements. But What if the numbers elements you have are even?
ex.
1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
31 32 33 34 35 36 37 38 39 40
41 42 43 44 45 46 47 48 49 50
51 52 53 54 55 56 57 58 59 60
how do you get your "P" in an even set of elements?
This explanation gives the detail I think you're looking for:
https://www.cs.duke.edu/courses/summer10/cps130/files/Edelsbrunner_Median.pdf
The median of the set plays a special role in this algorithm, and it
is defined as the i-smallest item where i = (n+1)/2 if n is odd and i =
n/2 or (n+2)/2 if n is even.

Strange aget optimisation behavior

Followup on this question about aget performance
There seems to be something very strange going on optimisation wise. We knew the following was true:
=> (def xa (int-array (range 100000)))
#'user/xa
=> (set! *warn-on-reflection* true)
true
=> (time (reduce + (for [x xa] (aget ^ints xa x))))
"Elapsed time: 42.80174 msecs"
4999950000
=> (time (reduce + (for [x xa] (aget xa x))))
"Elapsed time: 2067.673859 msecs"
4999950000
Reflection warning, NO_SOURCE_PATH:1 - call to aget can't be resolved.
Reflection warning, NO_SOURCE_PATH:1 - call to aget can't be resolved.
However, some further experimenting really weirded me out:
=> (for [f [get nth aget]] (time (reduce + (for [x xa] (f xa x)))))
("Elapsed time: 71.898128 msecs"
"Elapsed time: 62.080851 msecs"
"Elapsed time: 46.721892 msecs"
4999950000 4999950000 4999950000)
No reflection warnings, no hints needed. Same behavior is seen by binding aget to a root var or in a let.
=> (let [f aget] (time (reduce + (for [x xa] (f xa x)))))
"Elapsed time: 43.912129 msecs"
4999950000
Any idea why a bound aget seems to 'know' how to optimise, where the core function doesn't ?
It has to do with the :inline directive on aget, which expands to (. clojure.lang.RT (aget ~a (int ~i)), whereas the normal function call involves the Reflector. Try these:
user> (time (reduce + (map #(clojure.lang.Reflector/prepRet
(.getComponentType (class xa)) (. java.lang.reflect.Array (get xa %))) xa)))
"Elapsed time: 63.484 msecs"
4999950000
user> (time (reduce + (map #(. clojure.lang.RT (aget xa (int %))) xa)))
Reflection warning, NO_SOURCE_FILE:1 - call to aget can't be resolved.
"Elapsed time: 2390.977 msecs"
4999950000
You might wonder what's the point of inlining, then. Well, check out these results:
user> (def xa (int-array (range 1000000))) ;; going to one million elements
#'user/xa
user> (let [f aget] (time (dotimes [n 1000000] (f xa n))))
"Elapsed time: 187.219 msecs"
user> (time (dotimes [n 1000000] (aget ^ints xa n)))
"Elapsed time: 8.562 msecs"
It turns out that in your example, as soon as you get past reflection warnings, your new bottleneck is the reduce + part and not array access. This example eliminates that and shows an order-of-magnitude advantage of the type-hinted, inlined aget.
when you call through a higher order function all arguments are cast to object. In these cases the compiler can't figure out the type for the function being called because it is unbound when the function is compiled. It can only be determined that it will be something that can be called with some arguments. No warning is printed because anything will work.
user> (map aget (repeat xa) (range 100))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99)
you have found the edge where the clojure compiler gives up and just uses object for everything. (this is an oversimplified explanation)
if you wrap this in anything that gets compiled on it own (like an anonymous function) then the warnings become visible again, though they come from compiling the anonymous function, not form compiling the call to map.
user> (map #(aget %1 %2) (repeat xa) (range 100))
Reflection warning, NO_SOURCE_FILE:1 - call to aget can't be resolved.
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99)
and then the warning goes away when a type hint is added to the anonymous, though unchanging, function call.

Resources