15
$\begingroup$

I have built a solution to swap the lowest values with the highest values in a list.

With

SeedRandom[987] test = RandomSample@*Join @@ Range @@@ {{6, 10}, {56, 60}, {1, 5}, {-5, -1}} 
{-1, 2, 7, 8, 60, 57, 58, 10, 9, 4, -5, -3, 3, 59, 1, 5, -4, 6, -2, 56}

Then

swapPositions = PermutationReplace[ Ordering@Ordering@test, With[{len = Length@test}, Cycles@ Transpose@{Range @@ {1, Floor[len/2]}, Reverse@*Range @@ {Ceiling[len/2] + 1, len}} ] ]; Sort[test][[swapPositions]] 
{56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

The largest half of the numbers have had their positions swapped with lowest half of the numbers.

However, it feels too verbose and I think Sort might be expensive in this case. Is there a built-in function or more terse method to achieve this. Of course with no loss in speed. The actual case is for list of length 100000 and more.

Improve this question
$\endgroup$

4 Answers 4

Reset to default
3
$\begingroup$ 
Permute[Sort @ #, Reverse @ Ordering @ #] & @ test

{56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

Also

Permute[test[[#]], Reverse @ #] & @ Ordering[test]

{56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

and

test[[Reverse @ #]][[Ordering @ #]] & @ Ordering[test]

{56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

Improve this answer
$\endgroup$
17
$\begingroup$

How about:

Module[{tmp = test}, With[{ord=Ordering[tmp]}, tmp[[ord]] = Reverse @ tmp[[ord]]]; tmp ]

{56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ That is so obvious I want to cry. Thanks (+1). $\endgroup$ Commented Mar 22, 2019 at 21:15
8
$\begingroup$

This is equivalent to Carl's procedure, except that it uses one less scratch list:

With[{ord = Ordering[test]}, test[[PermutationProduct[Reverse[ord], InversePermutation[ord]]]]] {56, 9, 4, 3, -5, -2, -3, 1, 2, 7, 60, 58, 8, -4, 10, 6, 59, 5, 57, -1}

Recall that list[[perm]] = list is equivalent to list = list[[InversePermutation[perm]]], where perm is a permutation list. (The situation is equivalent to list.pmat being the same as Transpose[pmat].list if pmat is a permutation matrix.) You can then use PermutationProduct[] to compose successive permutations.

(This was supposed to be a comment, but it got too long.)

Improve this answer
$\endgroup$
8
  • $\begingroup$ This solution doesn't copy the list so may be faster than Carl's. (+1). $\endgroup$ Commented Mar 23, 2019 at 3:38
  • $\begingroup$ FWIW, I consistently get {56, -2, 6, -4, 5, 1, 59, 3, -3, -5, 4, 9, 10, 58, 57, 60, 8, 7, 2, -1} from this. $\endgroup$ Commented Mar 23, 2019 at 16:01
  • $\begingroup$ @Rabbit, what version number of Mathematica is giving that result? $\endgroup$ Commented Mar 23, 2019 at 16:10
  • $\begingroup$ 11.3.0.0 (5944644, 2018030701) Win 10. I did a trace, which might have had the needed info but I didn't catch it. Started w/ fresh kernel, & repeated, w/ same result. Baffled. $\endgroup$ Commented Mar 23, 2019 at 16:16
  • 1
    $\begingroup$ At least on my machine, the questioner's original (very verbose) proposed solution is faster than any other proposal. In order of presentation: 0.0000114366 v. 0.0000357762 v. 0.0000164219 (AbsoluteTiming in seconds). $\endgroup$ Commented Apr 3, 2019 at 14:10
2
$\begingroup$

Prior to v13.2:

1- Using SubsetMap is not compatible with much older versions. In that case, the Part method shown later can be used.

2- You can ignore the tnew list that has Red entries as it is for visualization only. In that case just use test

Clear["Global`*"]; SeedRandom[987]; test = RandomSample@*Join @@ Range @@@ {{6, 10}, {56, 60}, {1, 5}, {-5, -1}}; pos = FirstPosition[test, #] & /@ MinMax@test; tnew = MapAt[Style[#, Red] &, test, pos] res = SubsetMap[RotateLeft, tnew, pos]

swapping largest and smallest

Subsequent to v13.2:

Clear["Global`*"]; SeedRandom[987]; test = RandomSample@*Join @@ Range @@@ {{6, 10}, {56, 60}, {1, 5}, {-5, -1}}; posL = First@PositionLargest[test]; posS = First@PositionSmallest[test]; test[[{posL,posS}]]=test[[{posS,posL}]];test

same output without color with test having been modified in place

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.