22
\$\begingroup\$

A fun pair of equivalences is 1 + 5 = 2 · 3 and 1 · 5 = 2 + 3. There are many like these, another one is 1 + 1 + 8 = 1 · 2 · 5 and 1 · 1 · 8 = 1 + 2 + 5. In general a product of n positive integers equals a sum of n positive integers, and vice versa.

In this challenge you must generate all such combinations of positive integers for an input n > 1, excluding permutations. You can output these in any reasonable format. For example, all the possible solutions for n = 3 are:

(2, 2, 2) (1, 1, 6)
(1, 2, 3) (1, 2, 3)
(1, 3, 3) (1, 1, 7)
(1, 2, 5) (1, 1, 8)

The program that can generate the most combinations for the highest n in one minute on my 2GB RAM, 64-bit Intel Ubuntu laptop wins. If your answer uses more than 2GB of RAM or is written in a language I can not test with freely available software, I will not score your answer. I will test the answers in two weeks time from now and choose the winner. Later non-competing answers can still be posted of course.

Since it's not known what the full sets of solutions for all n are, you are allowed to post answers that generate incomplete solutions. However if another answer generates a (more) complete solution, even if their maximum n is smaller, that answer wins.


To clarify, here's the scoring process to decide the winner:

  1. I will test your program with n=2, n=3, etc... I store all your outputs and stop when your program takes more than a minute or more than 2GB RAM. Each time the program is run for a given input n, it will be terminated if it takes more than 1 minute.

  2. I look at all the results for all programs for n = 2. If a program produced less valid solutions than another, that program is eliminated.

  3. Repeat step 2 for n=3, n=4, etc... The last program standing wins.

\$\endgroup\$
  • 1
    \$\begingroup\$ So no answers in windows-exclusive languages? \$\endgroup\$ – Conor O'Brien Jul 30 '17 at 20:15
  • 3
    \$\begingroup\$ Personally, I dislike the scoring criteria. It's impossible to know whether our solutions will work and where to set the thresholds until we have results from the tests on your computer. I think a simple code-golf would make a better question. \$\endgroup\$ – musicman523 Jul 30 '17 at 20:23
  • 2
    \$\begingroup\$ I assume hardcoding is not allowed. But then that restriction is close to being unobservable \$\endgroup\$ – Luis Mendo Jul 30 '17 at 20:29
  • 1
    \$\begingroup\$ @user202729 I don't, I have to try each program for each n to see which program generates more solutions. \$\endgroup\$ – orlp Jul 31 '17 at 9:23
  • 2
    \$\begingroup\$ "Two weeks time from now" is 3 days ago. \$\endgroup\$ – G B Aug 16 '17 at 13:44
4
\$\begingroup\$

C (gcc), n = 50000000 with 6499 results in 59 s

To avoid producing over a terabyte of output consisting almost entirely of 1s, a sequence of (say) 49999995 1s is abbreviated as 1x49999995.

#include <stdio.h>
#include <stdlib.h>

static int n, *a1, k1 = 0, *a2, k2 = 0, s1, p1, *factor;

static void out() {
  if (s1 == p1) {
    for (int i = 0; i < k1 && i < k2; i++) {
      if (a1[i] < a2[i])
        return;
      else if (a1[i] > a2[i])
        break;
    }
  }

  for (int i = 0; i < k1; i++)
    printf("%d ", a1[i]);
  printf("1x%d | ", n - k1);
  for (int i = 0; i < k2; i++)
    printf("%d ", a2[i]);
  printf("1x%d\n", n - k2);
}

static void gen2(int p, int s, int m);

static void gen3(int p, int s, int m, int x, int q) {
  int r = s - n + k2 + 2;
  int d = factor[q];
  do {
    if (x * d <= m)
      x *= d;
    q /= d;
  } while (q % d == 0);
  do {
    if (q == 1) {
      a2[k2++] = x;
      gen2(p / x, s - x, x);
      k2--;
    } else {
      gen3(p, s, m, x, q);
    }
    if (x % d != 0)
      break;
    x /= d;
  } while (p / (x * q) >= r - x * q);
}

static void gen2(int p, int s, int m) {
  int n2 = n - k2;
  if (p == 1) {
    if (s == n2)
      out();
  } else if (n2 >= 1 && m > 1) {
    int r = s - n2 + 1;
    if (r < 2 || p < r)
      return;
    if (m > r)
      m = r;
    if (factor[p] <= m)
      gen3(p, s, m, 1, p);
  }
}

static void gen1(int p, int s, int m) {
  int n1 = n - k1;
  p1 = p;
  s1 = s + n1;
  gen2(s1, p1, s + n1 + 1 - n);
  if (n1 != 0) {
    int *p1 = &a1[k1++];
    for (int x = 2; x <= m && p * x <= s + x + n1 - 1; x++) {
      *p1 = x;
      gen1(p * x, s + x, x);
    }
    k1--;
  }
}

int main(int argc, char **argv) {
  if (argc < 2)
    return 1;
  n = atoi(argv[1]);
  if (n < 2)
    return 1;
  a1 = malloc(n * sizeof(int));
  a2 = malloc(n * sizeof(int));
  factor = calloc(4 * n - 1, sizeof(int));
  for (int p = 2; p < 4 * n - 1; p++)
    if (factor[p] == 0) {
      factor[p] = p;
      for (int i = p; i <= (4 * n - 2) / p; i++)
        factor[p * i] = p;
    } else if (factor[p] < factor[p / factor[p]]) {
      factor[p] = factor[p / factor[p]];
    }
  gen1(1, 0, 3 * n - 1);
  return 0;
}

Try it online!

\$\endgroup\$
3
\$\begingroup\$

Mathematica, n=293 with 12 solutions

OP changed the challenge and asks for input
Here is the new code that takes any n as input
For n=293 you get the 12 solutions

If[#<5,Union[Sort/@Select[Tuples[{1,2,3,4,5,6,7,8,9},{#}],Tr@#==Times@@#&]],For[a=1,a<3,a++,For[b=a,b<3,b++,For[c=b,c<5,c++,For[d=c,d<10,d++,For[e=d,e<300,e++,If[Tr[s=Join[Table[1,#-5],{a,b,c,d,e}]]==Times@@s,Print[s]]]]]]]]&


input

[n]

You can test this algorithm on Wolfram Sandbox which is an online freely available software
Just follow the link, paste the code (ctrl+v),paste input at the end of the code and press shift+enter to run.
You will get all my solutions in seconds

Here is also Try it online! in C++(gcc)
(Many thanks to @ThePirateBay for supporting and translating my code to a free language)

this program generates only solutions of the form {a,b,c}{a,b,c}
which means a+b+c=a*b*c

It takes 1 sec to compute

the twelve solutions are:

{1,1...,1,1,1,2,293} {1,1...,1,1,1,2,293}
{1,1...,1,1,1,3,147} {1,1...,1,1,1,3,147}
{1,1...,1,1,1,5,74} {1,1...,1,1,1,5,74}
{1,1...,1,1,2,2,98} {1,1...,1,1,2,2,98}
{1,1...,1,1,2,3,59} {1,1...,1,1,2,3,59}
{1,1...,1,1,2,5,33} {1,1...,1,1,2,5,33}
{1,1...,1,1,2,7,23} {1,1...,1,1,2,7,23}
{1,1...,1,1,2,8,20} {1,1...,1,1,2,8,20}
{1,1...,1,1,3,3,37} {1,1...,1,1,3,3,37}
{1,1...,1,1,3,4,27} {1,1...,1,1,3,4,27}
{1,1...,1,1,3,7,15} {1,1...,1,1,3,7,15}
{1,1...,1,2,2,6,13} {1,1...,1,2,2,6,13}

\$\endgroup\$
  • 1
    \$\begingroup\$ "If your answer [...] is written in a language I can not test with freely available software, I will not score your answer." \$\endgroup\$ – Leaky Nun Jul 31 '17 at 6:20
  • 4
    \$\begingroup\$ @GB "you are allowed to post answers that generate incomplete solutions" \$\endgroup\$ – user202729 Jul 31 '17 at 8:42
  • 1
    \$\begingroup\$ my program "..generates the most combinations for the highest n in one minute".It is not hardcoded.It just finds the first 12 "easiest" solutions in under a minute \$\endgroup\$ – J42161217 Jul 31 '17 at 8:42
  • 1
    \$\begingroup\$ It could be clearer that n was supposed to be an input. I clarified that now. It doesn't appear your program takes an input n. \$\endgroup\$ – orlp Jul 31 '17 at 12:02
  • 2
    \$\begingroup\$ @orlp Fixed! My program takes any n as input. For n=293 you get the 12 solutions. un-downvote please if since everything works! \$\endgroup\$ – J42161217 Jul 31 '17 at 12:24
2
\$\begingroup\$

Python 2, n=175, 28 results in 59s

Made it a little slower using a reduction factor 2, but gets more solutions starting with n=83

I get results for n up to 92 on TIO in a single run.

def submats(n, r):
    if n == r:
        return [[]]
    elif r > 6:
        base = 1
    else:
        base = 2
    mx = max(base, int(n*2**(1-r)))

    mats = []
    subs = submats(n, r+1)
    for m in subs:
        if m:
            mn = m[-1]
        else:
            mn = 1
        for i in range(mn, mx + 1):
            if i * mn < 3*n:
                mats += [m + [i]]
    return mats

def mats(n):
    subs = []
    for sub in submats(n, 0):
        sum = 0
        prod = 1
        for m in sub:
            sum += m
            prod *= m
        if prod > n and prod < n*3:
            subs += [[sub, sum, prod]]
    return subs

def sols(n):
    mat = mats(n)
    sol = [
        [[1]*(n-1)+[3*n-1],[1]*(n-2)+[2,2*n-1]],
    ]
    if n > 2:
        sol += [[[1]*(n-1)+[2*n+1],[1]*(n-2)+[3,n]]]
    for first in mat:
        for second in mat:
            if first[2] == second[1] and first[1] == second[2] and [second[0], first[0]] not in sol:
                sol += [[first[0], second[0]]];
    return sol

Try it online!

\$\endgroup\$
  • 1
    \$\begingroup\$ "keep 5 elements [1..2] and limit 3n..." I'm glad you liked my algorithm ;-) \$\endgroup\$ – J42161217 Aug 1 '17 at 10:41
  • \$\begingroup\$ I already did something similar in the Ruby version, and now I'm trying to remove that limitation. \$\endgroup\$ – G B Aug 1 '17 at 10:48
  • \$\begingroup\$ For a given n, how many solutions are hardcoded in your algorithm? \$\endgroup\$ – J42161217 Aug 1 '17 at 12:29
  • \$\begingroup\$ Not really hardcoded: 2 standard solutions can be generated using a shortcut (except for n=2 where they are the same combination), and by skipping these, I can limit the range to 2n instead of 3n. If this is considered hardcoded, I will change it. \$\endgroup\$ – G B Aug 1 '17 at 12:34
  • 1
    \$\begingroup\$ For 61 my result would be 28 your I remember it is 27... Possibly I made some error \$\endgroup\$ – RosLuP Aug 3 '17 at 9:38
1
\$\begingroup\$

Ruby, n=12 gets 6 solutions

At least on TIO, usual results for 1 up to 11

->n{
  arr=[*1..n*3].product(*(0..n-2).map{|x|
    [*1..[n/3**x,2].max]|[1]
  }).select{|a|
    a.count(1) >= n-4
  }.map(&:sort).uniq
  arr.product(arr).map(&:sort).uniq.select{|r|
    r[0].reduce(&:+) == r[1].reduce(&:*) &&
    r[0].reduce(&:*) == r[1].reduce(&:+)
  }
}

Try it online!

Gets 10 results under a minute for n=13 on my laptop.

\$\endgroup\$
1
\$\begingroup\$

Mathematica, n=19 with 11 solutions

this is my new answer according to OP's new criteria

(SOL = {};
For[a = 1, a < 3, a++, 
For[b = a, b < 3, b++, 
For[c = b, c < 5, c++, 
 For[d = c, d < 6, d++, 
  For[e = d, e < 3#, e++, 
   For[k = 1, k < 3, k++, 
    For[l = k, l < 3, l++, 
     For[m = l, m < 5, m++, 
      For[n = m, n < 6, n++, For[o = n, o < 3#, o++,
        s = Join[Table[1, # - 5], {a, b, c, d, e}];
        t = Join[Table[1, # - 5], {k, l, m, n, o}];            
        If[Tr[s[[-# ;;]]] == Times @@ t[[-# ;;]] && 
          Tr[t[[-# ;;]]] == Times @@ s[[-# ;;]], 
         AppendTo[SOL,{s[[-#;;]],t[[-#;;]]}]]]]]]]]]]]];
Union[SortBy[#,Last]&/@SOL])&

if you give an input [n] at the end, the program displays the solutions

here are my results (on my old laptop 64-bit 2.4GHz)

n->solutions
2 -> 2
3 -> 4
4 -> 3
5 -> 5
6 -> 4
7 -> 6
8 -> 5
9 -> 7
10 -> 7
11 -> 8
12 -> 6 (in 17 sec)
13 -> 10 (in 20 sec)
14 -> 7 (in 25 sec)
15 -> 7 (in 29 sec)
16 -> 9 (in 34 sec)
17 -> 10 (in 39 sec)
18 -> 9 (in 45 sec)
19 -> 11 (in 51 sec)
20 -> 7 (in 58 sec)

\$\endgroup\$
1
\$\begingroup\$

Haskell, a lot of solutions fast

import System.Environment

pr n v = prh n v v

prh 1 v l = [ [v] | v<=l ]
prh n 1 _ = [ take n $ repeat 1 ]
prh _ _ 1 = []
prh n v l = [ d:r | d <-[2..l], v `mod` d == 0, r <- prh (n-1) (v`div`d) d ]

wo n v = [ (c,k) | c <- pr n v, let s = sum c, s>=v,
                   k <- pr n s, sum k == v, s>v || c>=k ]

f n = concatMap (wo n) [n+1..3*n]

main = do [ inp ] <- getArgs
          let results = zip [1..] $ f (read inp)
          mapM_ (\(n,s) -> putStrLn $ (show n) ++ ": " ++ (show s)) results

f computes the solutions, the main function adds getting the input from the command line and some formatting and counting.

\$\endgroup\$
  • \$\begingroup\$ Compile like this: ghc -O3 -o prodsum prodsum.hs and run with command line argument: ./prodsum 6 \$\endgroup\$ – Christian Sievers Sep 7 '17 at 11:41
0
\$\begingroup\$

Haskell, n=10 with 2 solutions


import           Data.List

removeDups = foldl' (\seen x -> if x `elem` seen then seen else x : seen) []
removeDups' = foldl' (\seen x -> if x `elem` seen then seen else x : seen) []

f n= removeDups $ map sort filterSums
  where maxNumber = 4
        func x y = if (((fst x) == (fst.snd$y)) && ((fst y) == (fst.snd$x)))
                     then [(snd.snd$x),(snd.snd$y)]
                     else [[],[]]
        pOf = removeDups' $ (map sort (mapM (const [1..maxNumber]) [1..n]))
        sumOf = map (\x->((sum x),((product x), x))) pOf
        filterSums = filter (\x-> not$(x == [[],[]])) (funcsumOfsumOf)

This performs like crap, but I at least fixed it so I am actually addressing the challenge now!

Try it online!

\$\endgroup\$
  • \$\begingroup\$ for n=2 you get ["[3,3][2,3]","[2,2][2,2]","[1,3][2,2]","[1,2][1,3]","[1,1][1,2]"] which is wrong \$\endgroup\$ – J42161217 Jul 31 '17 at 19:23
  • \$\begingroup\$ All solutions seem to be wrong actually \$\endgroup\$ – G B Jul 31 '17 at 19:27
  • \$\begingroup\$ @Jenny_mathy How is it wrong? 3 + 3 is 6 and 2 * 3 is 6. Do i misunderstand the question. \$\endgroup\$ – maple_shaft Jul 31 '17 at 19:57
  • \$\begingroup\$ you are missing the "vice versa" \$\endgroup\$ – J42161217 Jul 31 '17 at 22:05
  • \$\begingroup\$ @Jenny_mathy Dumb mistake on my part! I fixed it, should work now. \$\endgroup\$ – maple_shaft Aug 1 '17 at 2:55
0
\$\begingroup\$

Axiom, n=83 in 59 seconds here

-- copy the below text in the file name "thisfile.input" 
-- and give something as the command below in the Axiom window:
-- )read C:\Users\thisuser\thisdirectory\thisfile

)cl all
)time on

-- controlla che l'array a e' formato da elementi  a.i<=a.(i+1)
tv(a:List PI):Boolean==(for i in 1..#a-1 repeat if a.i> a.(i+1) then return false;true)

-- funzione incremento: incrementa a, con #a=n=b/3,sotto la regola di "reduce(+,a)+#a-1>=reduce(*,a)"
-- e che n<reduce(*,a)<3*n ed reduce(+,a)<3*n 
inc3(a:List PI):INT==
   i:=1; n:=#a; b:=3*n
   repeat
      if i>n  then return 0
      x:=reduce(*,a)
      if x>=b then a.i:=1
      else
          y:=reduce(+,a)
          if y>b then a.i=1
          else if y+n-1>=x then
                      x:=x quo a.i
                      a.i:=a.i+1
                      x:=x*a.i
                      if tv(a) then break
                      else a.i:=1
          else a.i:=1
      i:=i+1
   if x<=n then return inc3(a) -- x<=n non va
   x

-- ritorna una lista di liste di 4 divisori di n
-- tali che il loro prodotto e' n
g4(n:PI):List List PI==
  a:=divisors(n)
  r:List List PI:=[]
  for i in 1..#a repeat
     for j in i..#a repeat
        x:=a.i*a.j
        if x*a.j>n then break
        for k in j..#a repeat
            y:=x*a.k
            if y*a.k>n then break
            for h in k..#a repeat
                z:=y*a.h
                if z=n  then r:=cons([a.h,a.k,a.j,a.i],r)
                if z>=n then break 
  r

-- ritorna una lista di liste di 3 divisori di n
-- tali che il loro prodotto e' n
g(n:PI):List List PI==
  a:=divisors(n)
  r:List List PI:=[]
  for i in 1..#a repeat
     for j in i..#a repeat
        x:=a.i*a.j
        if x*a.j>n then break
        for k in j..#a repeat
            y:=x*a.k
            if y=n  then r:=cons([a.k,a.j,a.i],r)
            if y>=n then break
  r

-- cerca che [a,b] nn si trovi gia' in r
searchr(r:List List List PI,a:List PI,b:List PI):Boolean==
  aa:=sort(a); bb:=sort(b)
  for i in 1..#r repeat
      x:=sort(r.i.1);y:=sort(r.i.2)
      if x=aa and y=bb then return false
      if x=bb and y=aa then return false
  true

-- input n:PI
-- ritorna r, tale che se [a,b] in r
-- allora #a=#b=n
--        ed reduce(+,a)=reduce(*,b) ed reduce(+,b)=reduce(*,a)
f(n:PI):List List List PI==
  n>100000 or n<=1 =>[]
  a:List PI:=[]; b:List PI:=[]; r:List List List PI:=[]
  for i in 1..n repeat(a:=cons(1,a);b:=cons(1,b))
  if n~=72 and n<86 then  m:=min(3,n)
  else                    m:=min(4,n) 
  q:=reduce(*,a) 
  repeat
    w:=reduce(+,a)
    if n~=72 and n<86 then x:= g(w)
    else                   x:=g4(w)
    if q=w then r:=cons([copy a, copy a],r)
    for i in 1..#x repeat
           for j in 1..m repeat
                  b.j:=(x.i).j
           -- per costruzione abbiamo che reduce(+,a)= prodotto dei b.i=reduce(*,b)
           -- manca solo di controllare che reduce(+,b)=reduce(*,a)=q
           if reduce(+,b)=q and searchr(r,a,b) then r:=cons([copy a, copy b],r)
    q:=inc3(a)
    if q=0 then break
  r

results:

 for i in 2..83 repeat output [i, # f(i)]
   [2,2][3,4][4,3][5,5][6,4][7,6][8,5][9,7][10,7][11,8][12,6][13,10][14,7][15,7]
   [16,10][17,10][18,9][19,12][20,7][21,13][22,9][23,14][24,7][25,13][26,11]
   [27,10][28,11][29,15][30,9][31,16][32,11][33,17][34,9][35,9][36,13][37,19]
   [38,11][39,14][40,12][41,17][42,11][43,20][44,12][45,16][46,14][47,14][48,13]
   [49,16][50,14][51,17][52,11][53,20][54,15][55,17]
   [56,14][57,20][58,17][59,16][60,15][61,28][62,15][63,16][64,17][65,18]
   [66,14][67,23][68,20][69,19][70,13][71,18][72,15][73,30][74,15][75,17][76,18]
   [77,25][78,16][79,27][80,9][81,23][82,17][83,26]


 f 3
    [[[1,2,5],[8,1,1]],[[1,3,3],[7,1,1]],[[1,2,3],[1,2,3]],[[2,2,2],[6,1,1]]]
                                     Type: List List List PositiveInteger
                                   Time: 0.07 (IN) + 0.05 (OT) = 0.12 sec

The way for run above text in Axiom, would be, copy all that text in a file, save the file with the name: Name.input, in a Axiom window use ")read absolutepath/Name".
results: (# f(i) finds the length of the array f(i), that is the number of solutions)

\$\endgroup\$

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.