5
\$\begingroup\$

You are given an array \$A\$, which may contain duplicate elements. In each swap, you may swap the value of any two indices \$i, j\$ (i.e. switch the values of \$A_i\$ and \$A_j\$). What is the least amount of swaps needed to sort the array, and what are the corresponding swapped indices?

Scoring

This is , so shortest code wins. However, your program must terminate in reasonable time (less than 10 seconds) for any array \$A\$ with less than 1000 elements.

Input

The array \$A\$, in any necessary form.

Output

A list of swaps, with each swap being a pair of numbers, in sequential order - first pair in list is swapped first, in any necessary form.
In the output, the numbers should all represent indices. You may output the answer either one-indexed or zero-indexed, but my samples will use one-indexing.
The answer might not be unique. However, your answer should still have the same length as the optimal sequence of swaps.

Test cases

[4,3,2,1] => [(1,4),(2,3)]
[1,3,2,3] => [(2,3)]
[1,2,1,3,2,3] => [(2,3),(4,5)]
[1,2,3,4] => []
[4,2,5,1,3,3] => [(2,6),(1,5),(1,4),(2,3)]
\$\endgroup\$
  • \$\begingroup\$ Yes, yes, and yes (although there may be more than one optimal sequence, yours should still have the same length as the optimal sequence) \$\endgroup\$ – Baaing Cow Dec 28 '19 at 3:23
  • 1
    \$\begingroup\$ Can you please add more and longer test cases? \$\endgroup\$ – Jonah Dec 28 '19 at 8:07
  • 1
    \$\begingroup\$ @Jonah Done. Although the samples may be quite a bit suggestive... \$\endgroup\$ – Baaing Cow Dec 28 '19 at 8:37
  • 1
    \$\begingroup\$ Per @Neil's comment on my answer, can you please add the test case 4,5,2,1,3,3 with expected length 4. (1 5) (0 4) (0 3) (1 2) is one possible (0-indexed) solution. This test case ensures that you can't just use the same algorithm that works for the "no repeats" case. \$\endgroup\$ – Jonah Dec 28 '19 at 18:48
  • 1
    \$\begingroup\$ @BaaingCow are you sure this is possible within 10 seconds when there are multiple identical numbers, as per comments below the J and Jelly answers? \$\endgroup\$ – Nick Kennedy Dec 28 '19 at 18:48
3
\$\begingroup\$

Jelly, 51 43 bytes

ṪµṢ,$Ḣ©€E¬a="ʋṚƊ×\ẸÞṪTḢ,®ṛ¦Ẹ}¡@¥
WÇẸпFĖẠƇÄ

Try it online!

A pair of links which when called as a monad returns a list of pairs of 1-indexed indices to swap. Based on the clever J algorithm developed by @Jonah, so be sure to upvote that one too!

Explanation

Helper link

Takes a list containing a list of the remaining items to be sorted, optionally preceded by the most recent swap. Takes full advantage of the way that (Head) and (tail) pop items from a list, which for someone from an R background was something I found took some getting used to when I started using Jelly!

Ṫ                                 | Tail (yields the list of remaining items, and also removes this from the list that п is collecting up)
 µ                                | Start a new monadic chain
  Ṣ,$                             | Pair the sorted list with the unsorted remaining items
     Ḣ©€                          | Take the head of each, removing from the list and storing each in turn in the register (so the register is left holding the head of the unsorted list)
               Ɗ                  | Following as a monad
             ʋṚ                   | - Following as a dyad, using a list of the remaining sorted and unsorted lists (in that order) as right argument
        E                         |   - Equal (i.e. the head of the unsorted and sorted lists matches)
         ¬                        |   - Not
          a                       |   - And:
              ="                  |     - Equal to zipped right argument (effectively a logical list indicating which of the remainder of the sorted list matched the head of the unsorted and vice-versa)
                ×\                | Cumulative product
                  ẸÞ              | Sort by whether any true
                    Ṫ             | Tail
                     T            | Convert to list of truthy indices
                      Ḣ           | Head (will be 0 if the head of the unsorted and sorted lists matches)
                               ¥  | Following as a dyad, using the remaining unsorted list as right argument
                       ,          | Pair the index to swap with:
                              @   | - Following with arguments reversed:
                           Ẹ}¡    |   - Run following once if index to swap is nonzero:
                        ®ṛ¦       |     - Replace item at index to swap with the original head of the unsorted list that was stored in the register

Main link, takes a list to be sorted

W           | Wrap in a further list
  Ẹп       | While any non-zero, do the following collecting up intermediate results
 Ç          | - Call helper link
     F      | Flatten (will remove the now empty initial list)
      Ė     | Enumerate (pair the index of each with the item)
       ẠƇ   | Keep only those without zeros
         Ä  | Cumulative sum of each pair

Original algorithm that fails with repeated values, 16 bytes

ỤịƬ€`Ṣ€ŒQTịƲṡ€2Ẏ

Try it online!

A monadic link taking a list of integers and returning a list of lists of integers representing the 1-indexed swaps.

Explanation

Ụ                 | Grade the list z up, i.e., sort its indices by their corresponding values.
  Ƭ€`             | For each member of the resulting list, do the following until no new values, using the list of indices itself as the right argument. Keep all intermediate values. 
 ị                | - Index into list
           Ʋ      | Following as a monad:
     Ṣ€           | - Sort each list
       ŒQ         | - Logical list, true for original copy of each unique value
         T        | - Indices of truthy values
          ị       | - Index into list
            ṡ€2   | Split each into overlapping sets of 2
               Ẏ  | Join outer together

Inefficient algorithm that is too slow for long lists with lots of repeats, 27 bytes

ĠŒ!€ŒpµFịƬ€`Ṣ€ŒQTịƲṡ€2Ẏ)LÞḢ

Try it online!

\$\endgroup\$
  • \$\begingroup\$ Looks like this fails on the same one that mine does: 4 5 2 1 3 3 (courtesy of Neil) \$\endgroup\$ – Jonah Dec 28 '19 at 17:13
  • 1
    \$\begingroup\$ @Jonah indeed. I’ve tried testing the Cartesian product of all permutations of identical ones but it fails for the last two examples because there are too many possibilities. I’ll give it some more thought. \$\endgroup\$ – Nick Kennedy Dec 28 '19 at 18:45
  • \$\begingroup\$ Yep. I'm stuck on exactly the same thing. \$\endgroup\$ – Jonah Dec 28 '19 at 18:45
  • 1
    \$\begingroup\$ @Jonah Very clever! I’ve rewritten your algorithm in Jelly. The implementation is different in places, but the overall idea is the same. \$\endgroup\$ – Nick Kennedy Dec 30 '19 at 17:44
  • 1
    \$\begingroup\$ Thanks Nick! I was kinda hoping you'd do a Jelly one -- was curious how compact it would be. My J solution could be golfed further but I think it will be somewhat long no matter what because these procedural algorithms aren't a great fit for J. \$\endgroup\$ – Jonah Dec 30 '19 at 17:48
5
\$\begingroup\$

J, 126 bytes

[:>[:{:"1@}./:~(({.@I.@:~:>@{.)({:@](|.@:{`[`]}~;])[,[:(0{*/,&I.{.)(<0{i.@$)*"1{"0 1=|.@])(,:>@{.))^:(-.@-:>@{.)^:a:;&(0 2$'')

Try it online!

Here is the same code in a more procedural form, if you're looking for an explanation of algorithm.

f=. 3 :0
sorting=.y NB. copy of input we'll mutate
sorted=./:~y
swaps=.0 2$''
for_j. i.#y do.
  correct=.j{sorted
  cur=.j{sorting
  if. cur = correct do.
    continue.
  end.
  NB. correctly fill the current idx j
  valid_idxs=.(j<i.#sorting)
  good_j=. valid_idxs * correct = sorting 
  NB. will any of these be the correct desitnation for the current elm?
  good_dest=. valid_idxs * cur = sorted
  both=.good_j * good_dest
  use=.(1 e.both) { good_j ,: both
  swap_with=. {.I.use
  swaps=.swaps,(j, swap_with)
  sorting=.(sorting {~ swap_with, j) (j, swap_with)} sorting
end.
swaps
)

Try it online!


original answer, doesn't work for repeats

J, 18 bytes

[:;(2]\])&.>@C.@/:

Try it online!

NOTE: Thanks to Neil for pointing out this currently fails on the test case 4 5 2 1 3 3.

  • /: Grade up, ie, return the permutation that puts the list into order
  • C.@ Convert that to cyclic permutation form, which uses boxes
  • &.> For each of those boxed lists, ie, permutation cycles...
  • (2]\]) Return all consecutive pairs of two elements. This gives us the swaps, and it works because J gives the cycle list in descending order.
  • [:; raze the list of boxes. This gives us all the swap pairs as a single list of pairs, ie, an N x 2 matrix.
\$\endgroup\$
  • 1
    \$\begingroup\$ Wow. Can you explain how it works, and what strategy you used to solve this? \$\endgroup\$ – Baaing Cow Dec 28 '19 at 10:06
  • \$\begingroup\$ @BaaingCow Done. \$\endgroup\$ – Jonah Dec 28 '19 at 10:14
  • \$\begingroup\$ @BaaingCow Btw, my swaps with this method are all listed in descending order (ie, 3 1 for swapping 1 and 3). lmk if that's not acceptable, and I'll reverse them. It only adds a few bytes. \$\endgroup\$ – Jonah Dec 28 '19 at 10:23
  • \$\begingroup\$ Suppose your input is 4,5,2,1,3,3 (or whatever the ambiguous equivalent would be for your code). What's to stop the code outputting 1,4;4,6;6,2;2,3;3,5? \$\endgroup\$ – Neil Dec 28 '19 at 11:25
  • \$\begingroup\$ Excellent catch, @Neil . The problem is there are multiple valid grade ups bc of the repeats, and they can lead to solns of different length. I could brute force all of them, which seems excessive. I think it would be enough to brute force the endpoints of runs of repeats. Is that the best I could do? \$\endgroup\$ – Jonah Dec 28 '19 at 16:24
3
\$\begingroup\$

Wolfram Language (Mathematica), 219 188 184 bytes

F@A_:=MinimalBy[##&@@@f/@#[[1]]&@*(FindPermutation@A~PermutationProduct~#&)/@GroupElements@PermutationGroup[Cycles@*List/@Join@@((f=Partition[#,2,1]&)/@Values@PositionIndex@A)],Length]

Try it online!

-31 bytes thanks to @Chris

-4 bytes by making the code much faster (no more GroupSetwiseStabilizer slowness)

Thanks to @NickKennedy for pointing out that the first version failed on non-unique list entries. The present version is a tour-de-force that calculates the permutation group that leaves the list unchanged, then tries each element of this group to see if it can be used to shorten the result.

This code still goes very slowly on massively duplicated lists.

Explicit code:

A = {4,5,2,1,3,3,10,9,7,6,8,8}
  (* compute the indices of equal elements *)
Q = Values[PositionIndex[A]]
  (* compute the permutation group that leaves A invariant *)
G = PermutationGroup[Cycles@*List /@ Join @@ (Partition[#, 2, 1] & /@ Q)]
  (* find the permutation that sorts A and combine it with every element of G *)
F = PermutationProduct[FindPermutation[A], #] & /@ GroupElements[G]
  (* convert every resulting permutation to the desired form *)
J = Join @@ (Partition[#, 2, 1] & /@ #[[1]]) & /@ F
  (* pick the shortest solutions *)
MinimalBy[J, Length]
\$\endgroup\$
  • 2
    \$\begingroup\$ Fails the same edge cases that Jonah’s and mine do - see comments above. \$\endgroup\$ – Nick Kennedy Dec 28 '19 at 20:08
  • \$\begingroup\$ Thanks @NickKennedy! Fixed. \$\endgroup\$ – Roman Dec 29 '19 at 19:41
  • \$\begingroup\$ well done. However, you’ve now run into the same issue that Jonah and I had with using permutations - the runtime becomes very long for longer inputs with duplicates such as the last two sets in the original question. This answer certainly won’t handle a 1000 length list with lots of duplicates. I’m still waiting to hear from the OP about this, but my suspicion is you can choose between duplicates and a quick run time but can’t have both. \$\endgroup\$ – Nick Kennedy Dec 29 '19 at 19:45
  • \$\begingroup\$ @NickKennedy my suspicion is that this problem needs to be solved in GAP by someone who is well versed in group theory. Maybe there are some group-theoretical shortcuts to be had. Not an easy problem. \$\endgroup\$ – Roman Dec 29 '19 at 21:03
  • 1
    \$\begingroup\$ not sure if you’ve seen, but there are now working solutions in J and Jelly \$\endgroup\$ – Nick Kennedy Dec 31 '19 at 1:01

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.