21
\$\begingroup\$

You are given a set of positive integers. You must arrange them into pairs such that:

  • Each pair contains 2 numbers, one of which is a multiple of another. For example, 8 is a multiple of 4, and 9 is a multiple of 9.
  • If the same number occurs many times in the initial set, it can be used that many times in the pairs; a number can even be paired with another occurence of the same number
  • The maximum possible number of pairs is obtained.

Output must be the number of pairs. Shortest code wins.

Sample data

2,3,4,8,9,18 -> 3

7,14,28,42,56 -> 2

7,1,9,9,4,9,9,1,3,9,8,5 -> 6

8,88,888,8888,88888,888888 -> 3

2,6,7,17,16,35,15,9,83,7 -> 2

Improve this question
\$\endgroup\$
2
  • 3
    \$\begingroup\$ Anyone know whether this problem is NP-complete? I think the smallest "hard" set is 2,3,4,8,9,18. (Each number in that list is a factor and/or multiple of at least two other numbers in the list, but it has only one solution.) \$\endgroup\$
    – Neil
    Nov 26, 2015 at 22:55
  • 1
    \$\begingroup\$ It is [assuming P!=NP] not NP-complete, as finding a maximum-cardinality matching is in P even in the general case (e.g. Hopcroft-Karp algorithm). On the other hand, this problem is at least as hard as maximal bipartite matchings (label one side with distinct primes, and the other side with appropriate products of them). \$\endgroup\$
    – ManfP
    Oct 17, 2020 at 18:26

11 Answers 11

Reset to default
6
\$\begingroup\$

Haskell, 109 107 76 70 bytes

Thanks to nimi for saving 33 bytes and teaching me some more Haskell. :)
Thanks to xnor for saving another 6 bytes.

import Data.List
f l=maximum$0:[1+f t|a:b:t<-permutations l,a`mod`b<1]

Yay, my first Haskell golf. It works the same as all the answers so far (well, not quite: it only counts the length of the longest prefix of valid pairs in each permutation, but that's equivalent and is actually what my original CJam code did).

For extra golfitude it's also extra inefficient by recursively generating all permutations of the suffix each time the first two elements of a permutation are a valid pair.

Improve this answer
\$\endgroup\$
6
  • \$\begingroup\$ Is the f= necessary? \$\endgroup\$
    – Alex A.
    Nov 25, 2015 at 17:22
  • \$\begingroup\$ @AlexA. I'm not sure what the standard policy on PPCG for unnamed functions in Haskell is, but I've checked a few other Haskell answers and they used named functions. Also, you'd technically have to use parentheses around the function if you wanted to use it as an unnamed function, so that would be the same byte count anyway I guess. \$\endgroup\$
    – Martin Ender
    Nov 25, 2015 at 17:26
  • \$\begingroup\$ @nimi Thanks for letting me know. :) Do you see anything else that could be shortened? The import for chunksOf is painful. I don't really know Haskell's standard library to be able to tell if there is a shorter equivalent function. I tried implementing it myself, but it came out two or three bytes longer than the import. \$\endgroup\$
    – Martin Ender
    Nov 26, 2015 at 10:35
  • \$\begingroup\$ ohhh, catching both [] and [_] at the same time by putting g x=[] second is really clever. I'll give that a try. Thanks :) \$\endgroup\$
    – Martin Ender
    Nov 26, 2015 at 10:56
  • \$\begingroup\$ Looks a bit shorter to define the whole function recursively: f l=maximum$0:[1+f t|(a:b:t)<-permutations l,a`mod`b<1]. \$\endgroup\$
    – xnor
    Nov 26, 2015 at 11:19
6
\$\begingroup\$

Japt -h, 11 bytes

My 1000th Japt solution! (According to SEDE)
I had wanted to do something epic to mark the occasion but I couldn't find a suitable challenge and, also, realised I don't have the time or brainspace these days for epic. So, instead I shall "celebrate" with a victory over Jelly :) And a bag of cans, of course!

á ®ò xr'vÃñ

Try it

á ®ò xr'vÃñ     :Implicit input of array
á               :Permutations
  ®             :Map
   ò            :  Partitions of length 2
     x          :  Reduce by addition after
      r         :    Reducing each by
       'v       :    Testing divisibility
         Ã      :End map
          ñ     :Sort
                :Implicit output of last element

The 'v trick saves a byte over the more straightforward method of using a function which would be xÈrvà instead of xr'v, although we could get that byte back by replacing the Ãà with a newline.

Improve this answer
\$\endgroup\$
3
\$\begingroup\$

CJam, 22 18 bytes

q~e!{2/::%0e=}%:e>

Try it online.

Expects input in the form of a CJam-style list.

This is a bit inefficient for larger lists (and Java will probably run out of memory unless you give it more).

Explanation

q~     e# Read and evaluate input.
e!     e# Get all distinct permutations.
{      e# Map this block onto each permutation...
  2/   e#   Split the list into (consecutive) pairs. There may be a single element at the
       e#   end, which doesn't participate in any pair.
  ::%  e#   Fold modulo onto each chunk. If it's a pair, this computes the modulo, which
       e#   yields 0 if the first element is a multiple of the second. If the list has only
       e#   one element, it will simply return that element, which we know is positive.
  0e=  e#   Count the number of zeroes (valid pairs).
}%
:e>    e# Find the maximum of the list by folding max() onto it.
Improve this answer
\$\endgroup\$
2
  • \$\begingroup\$ It does not give output for [1 2 3 4 5 6 7 8 9 10] However [7 1 9 9 4 9 9 1 3 9 8 1] which is a longer list, works properly. Why is that? \$\endgroup\$
    – ghosts_in_the_code
    Nov 25, 2015 at 11:25
  • 1
    \$\begingroup\$ @ghosts_in_the_code Because the former has more distinct permutations. 10! = 3628800, but 12! / 5! / 3! = 665280. So it runs out of memory for the first case. If you ran it from the console with the Java interpreter, you could tell Java to use more memory and the first case would work as well (although it might take a while, don't know). \$\endgroup\$
    – Martin Ender
    Nov 25, 2015 at 12:29
3
\$\begingroup\$

Pyth, 13 bytes

eSm/%Mcd2Z.pQ

The time and storage complexity is really terrible. The first thing I do is to create a list with all permutations of the originally list. This takes n*n! storage. Input lists with length 9 already take quite a long time.

Try it online: Demonstration or Test Suite

Explanation:

eSm/%Mcd2Z.pQ
            Q   read the list of integer
          .p    create the list of all permutations
  m             map each permutation d to:
      cd2          split d into lists of length 2
    %M             apply modulo to each of this lists
   /     Z         count the zeros (=number of pairs with the first 
                   item divisible by the second)
 S              sort these values
e               and print the last one (=maximum)
Improve this answer
\$\endgroup\$
2
\$\begingroup\$

Mathematica, 95 93 87 83 79 60 58 bytes

Max[Count[#~Partition~2,{a_,b_}/;a∣b]&/@Permutations@#]&

Takes a few seconds for the larger examples.

Improve this answer
\$\endgroup\$
0
2
\$\begingroup\$

Jelly, 12 bytes

Œ!s2ḍ/€ċ1Ʋ€Ṁ

Try it online!

Uses the same method as Jakube's Pyth answer and Martin's CJam answer, which seems to be the best method

How it works

Œ!s2ḍ/€ċ1Ʋ€Ṁ - Main link. Takes a list l on the left
Œ!           - All permutations of l
         Ʋ€  - Do the following over each permutation:
  s2         -   Split into pairs
      €      -   Over each pair:
     /       -     Reduce the pair by:
    ḍ        -       x divides y?
       ċ1    -   Count the 1s
           Ṁ - Take the maximum
Improve this answer
\$\endgroup\$
2
+25
\$\begingroup\$

Scala, 71 67 bytes

_.permutations.map(_.grouped(2)count(x=>x.size>1&&x(0)%x(1)<1)).max

Try it online!

  • -4 thanks to user!
Improve this answer
\$\endgroup\$
1
  • \$\begingroup\$ Awesome answer! Save a couple bytes with _ \$\endgroup\$
    – user
    Oct 18, 2020 at 19:21
1
\$\begingroup\$

05AB1E, 8 bytes

œεüÖιO}à

Try it online!

Commented:

œ          # get all permutations
 ε    }    # map over the permutations ... ex: [8, 4, 9, 9]
  üÖ       #   pairwise divisibility           [1, 0, 1]
           #     [8%4==0, 4%9==0, 9%9==0]
    ι      #   de-interleave                   [[1, 1], [0]]
           #     split into two alternating lists
     O     #   sum both lists                  [2, 0]
       à   # get the maximum
Improve this answer
\$\endgroup\$
1
\$\begingroup\$

Husk, 10 bytes

▲mȯ#IĊ2Ẋ¦P

Try it online!

How?

▲mȯ#IĊ2Ẋ¦P      
▲               # maximum of
 m              # map function over list:
  ȯ             # function: 3 functions combined
   #I           #   number of truthy elements of
     Ċ2         #   every second element of
       Ẋ        #   result of applying to every pair
        ¦       #   a divides b?
         P      # list: all permutations of input
Improve this answer
\$\endgroup\$
0
\$\begingroup\$

Matlab (120+114=234)

  function w=t(y,z),w=0;for i=1:size(z,1),w=max(w,1+t([y,z(i,:)],feval(@(d)z(d(:,1)&d(:,2),:),~ismember(z,z(i,:)))));end

main:

  a=input('');h=bsxfun(@mod,a,a');v=[];for i=1:size(h,1) b=find(~h(i,:));v=[v;[(2:nnz(b))*0+i;b(b~=i)]'];end;t([],v)

  • the topper function is called by the main part.

  • the input is in the form [. . .]

Improve this answer
\$\endgroup\$
0
\$\begingroup\$

Matlab(365)

  j=@(e,x)['b(:,' num2str(e(x)) ')'];r=@(e,y)arrayfun(@(t)['((mod(' j(e,1) ',' j(e,t) ')==0|mod(' j(e,t) ',' j(e,1) ')==0)&',(y<4)*49,[cell2mat(strcat(r(e(setdiff(2:y,t)),y-2),'|')) '0'],')'],2:y,'UniformOutput',0);a=input('');i=nnz(a);i=i-mod(i,2);q=0;while(~q)b=nchoosek(a,i);q=[cell2mat(strcat((r(1:i,i)),'|')) '0'];q=nnz(b(eval(q(q~=0)),:));i=i-2;end;fix((i+2)/2)

  • This apparently is longer, but oneliner and executive, and I managed to escape perms function because it takes forever.

  • This function takes many reprises to run quiet well due to anonymous functions, I m open to suggestions here :)

Improve this answer
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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