3
$\begingroup$

Background:

The question derive from this question.But some criteria is omited by me.So I try to post a new question for this.If my expression is dimness and you have got it,just tell me or edit my post in place please.


I have a list2 like this:

SeedRandom[2016317];
list2 = RandomSample[Range@100, 20];

I want gather it whith two element but whithout no repeat element to nearest 100.As the answer,I make a function to serve this:

Pair[l_List] := Module[{k, f}, k = Subsets[Range@Length@l, {2}];
  f = Nearest[# -> Range@Length@#] &[Plus @@ l[[#]] & /@ k];
  k[[f[100, Length[l]/2]]]]

This result

 Pair[list2]
{{6,14},{7,11},{11,19},{2,5},{9,11},{12,16},{3,4},{3,12},{6,20},{15,19}}

We can found out some elements is used two times,such as the 19th,11th,12th and 12th.It's unexpectation for me.I still feel some descriptions is not accurate.If you get it,help me improve this question.I'll appreciate you very much.

$\endgroup$
3
$\begingroup$
getOrdpairs[l_List, objective_?NumericQ] := Module[
  {s = Subsets[Range@Length@l, {2}],
   c = SortBy[{#, Abs[objective - Plus @@ l[[#]]]} & /@ s, Last]},
  Reap[Nest[ DeleteCases[#, Alternatives @@ ({{___, #, ___}, _} & /@ Sow@#[[1, 1]])] &, 
             c, Floor[Length@l/2]]][[-1, -1]]]

Usage:

SeedRandom[2016317];
l = RandomSample[Range@100, 20]; 
pairs = getOrdpairs[l, 100]

(* {{6, 14}, {7, 11}, {2, 5}, {12, 16}, {3, 4}, {8, 10}, {15, 19}, 
    {18, 20}, {1, 17}, {9, 13}} *)

and the corresponding sums are:

Plus @@ l[[#]] & /@ pairs

(* {101, 101, 98, 98, 97, 97, 103, 106, 93, 91} *)

Edit:

Perhaps less efficient, but I like it better:

getOrdpairs1[l_List, objective_?NumericQ] := Module[

   {s = SortBy[Subsets[Range@Length@l, {2}], Abs[100 - Plus @@ l[[#]]] &],
    c = UndirectedEdge @@@ s},

    Reap[Nest[EdgeList@VertexDelete[Graph@#, Sow[List @@ #[[1]]]] &, c, 
              Floor[Length@l/2]]]][[-1, -1]]
$\endgroup$
  • $\begingroup$ Your code astonish me again.. $\endgroup$ – yode Mar 21 '16 at 7:19
1
$\begingroup$

Simple Sort works good here.

SeedRandom[2016317];
list2=RandomSample[Range@100,20]

{20,42,89,8,56,96,39,21,40,76,62,14,51,5,66,84,73,99,37,7}

list = Sort@list2

{5,7,8,14,20,21,37,39,40,42,51,56,62,66,73,76,84,89,96,99}

My idea is in grouping {min, max}, {2nd min, 2nd max} etc.

Partition[Sort[Thread[#->Range@Length@#]&@list2],10];
Partition[Riffle@@({#[[1,;;,2]],Reverse@#[[2,;;,2]]}&@%),2]
Total[list2[[#]]&/@%,{2}]

{{14,18},{20,6},{4,3},{12,16},{1,10},{8,17},{19,15},{7,11},{9,5},{2,13}}

{104, 103, 97, 98, 96, 94, 103, 101, 96, 93}

Variant 2 with Ordering:

Partition[Riffle[Ordering[list2, 10], Reverse@Ordering[list2, -10]],2]

UPDATE

Variant 3 (after discussion with Dr.belisarius in comments):

ClearAll[list, list2, list3, ord, elem, pos]

pairs[list_List] /; (EvenQ@Length@list) :=
 Module[
  {list2 = list, ord, elem, pos},
  Reap[
    Do[
     ord = Ordering[list2, -1][[1]];
     elem = list2[[ord]];
     list2 = Delete[list2, ord];
     pos = Position[#, Nearest[#, 100][[1]]][[1, 1]] &@(list2 + elem);
     Sow[{list2[[pos]], elem}];
     list2 = Delete[list2, pos];,
     {10}
     ]
    ][[2, 1]]
  ]

SeedRandom[2016317];
list2 = RandomSample[Range@100, 20]

list3 = {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 40, 60, 30, 70};
pairs[list2]

{{5,99},{7,96},{8,89},{14,84},{21,76},{20,73},{37,66},{39,62},{42,56},{40,51}}

pairs[list3]

{{30,70},{40,60},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1}}

Dr. belisarius' solution uses Subsetsand on the big lists can be memory hungry. My code has another problem: it returns grouped elements not their indexes.

$\endgroup$
  • $\begingroup$ Perhaps I am misunderstanding something. The objective seems to get the pairs whose sums are the nearest to 100. In list2 = {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 40, 60, 30, 70} there are two possible 100 sums, but your code returns none. Could you clarify? $\endgroup$ – Dr. belisarius Mar 21 '16 at 4:56
  • $\begingroup$ @Dr.belisarius From the linked question "Assumption we have a list2 like this. But wanna group it EVERY TWO ELEMENT that make its sum nearest 100." $\endgroup$ – Alexey Golyshev Mar 21 '16 at 5:06
  • $\begingroup$ Well, I expected the result for the above list to be {100, 100, 2, 2, 2, ...}. But as I said, perhaps I am wrong $\endgroup$ – Dr. belisarius Mar 21 '16 at 5:15
  • $\begingroup$ @Dr.belisarius Hmmm... It looks like you're right. My code works incorrectly with your example. $\endgroup$ – Alexey Golyshev Mar 21 '16 at 5:21
  • $\begingroup$ No process for nearest to 100.But anyway thanks for your effort.:) $\endgroup$ – yode Mar 21 '16 at 7:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.