36
\$\begingroup\$

Gozinta Chains

(Inspired by Project Euler #606)

A gozinta chain for n is a sequence {1,a,b,...,n} where each element properly divides the next. For example, there are eight distinct gozinta chains for 12:

{1,12}, {1,2,12}, {1,2,4,12}, {1,2,6,12}, {1,3,12}, {1,3,6,12}, {1,4,12} and {1,6,12}.

The Challenge

Write a program or function that accepts a positive integer (n > 1) and outputs or returns all the distinct gozinta chains for the given number.

  1. Order in the chains matters (ascending), order of the chains does not.
  2. On the off-chance it exists, you cannot use a builtin that solves the challenge.
  3. This is .

Edit: Removing 1 as a potential input.

\$\endgroup\$
  • 4
    \$\begingroup\$ Welcome to PPCG. Nice first question! \$\endgroup\$ – AdmBorkBork Aug 15 '17 at 17:57
  • 5
    \$\begingroup\$ "On the off-chance it exists [(looking at you, Mathematica!)]" \$\endgroup\$ – Erik the Outgolfer Aug 15 '17 at 17:59
  • 3
    \$\begingroup\$ As AdmBorkBork said, edge-cases are generally added only if they are important to the core of the challenge - if you want a reason for only [[1]] I'd say that if [1,1] is a gozinta of 1 then [1,1,12] is a gozinta of 12 as is [1,1,1,12] and now we can no longer "return all..." \$\endgroup\$ – Jonathan Allan Aug 15 '17 at 18:15
  • 4
    \$\begingroup\$ You should make the pun clear in the question for those who don't know it. 2|4 is read "two goes into four" aka "two gozinta four". \$\endgroup\$ – mbomb007 Aug 15 '17 at 21:45
  • 1
    \$\begingroup\$ Two and a half hours is not enough time for the sandbox to work. See the sandbox FAQ. \$\endgroup\$ – Peter Taylor Aug 15 '17 at 22:22

19 Answers 19

10
\$\begingroup\$

Python 3, 68 65 bytes

Edit: -3 bytes thanks to @notjagan

f=lambda x:[y+[x]for k in range(1,x)if x%k<1for y in f(k)]or[[x]]

Try it online!

Explanation

Each gozinta chain consists of the number x at the end of the chain, with at least one divisor to the left of it. For each divisor k of x the chains [1,...,k,x] are distinct. We can therefore for each divisor k find all of its distinct gozinta chains and append x to the end of them, to get all distinct gozinta chains with k directly to the left of x. This is done recursively until x = 1 where [[1]] is returned, as all gozinta chains start with 1, meaning the recursion have bottomed out.

The code becomes so short due to Python list comprehension allowing double iteration. This means that the values found in f(k) can be added to the same list for all of the different divisors k.

\$\endgroup\$
  • \$\begingroup\$ was trying to do this, too late now =/ \$\endgroup\$ – Rod Aug 15 '17 at 18:22
  • 3
    \$\begingroup\$ This answer is incredibly fast compared to the other ones thus far. \$\endgroup\$ – ajc2000 Aug 15 '17 at 18:23
  • \$\begingroup\$ -3 bytes by removing the unnecessary list unpacking. \$\endgroup\$ – notjagan Aug 15 '17 at 18:24
7
\$\begingroup\$

Husk, 13 bytes

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

A somewhat different approach to that of H.PWiz, though still by brute force. Try it online!

Explanation

The basic idea is to concatenate all subsequences of [1,...,n] and split the result into sublists where each element divides the next. Of these, we keep those that start with 1, end with n and contain no duplicates. This is done with the "rangify" built-in . Then it remains to discard duplicates.

ufo=ḣ⁰…ġ¦ΣṖḣ⁰  Input is n=12.
           ḣ⁰  Range from 1: [1,2,..,12]
          Ṗ    Powerset: [[],[1],[2],[1,2],[3],..,[1,2,..,12]]
         Σ     Concatenate: [1,2,1,2,3,..,1,2,..,12]
       ġ¦      Split into slices where each number divides next: [[1,2],[1,2],[3],..,[12]]
 fo            Filter by
      …        rangified
   =ḣ⁰         equals [1,...,n].
u              Remove duplicates.
\$\endgroup\$
  • \$\begingroup\$ I'm guessing it's not any shorter to filter to the arrays in the powerset where each number divides the next? \$\endgroup\$ – ETHproductions Aug 15 '17 at 20:16
  • \$\begingroup\$ @ETHproductions No, that's one byte longer. \$\endgroup\$ – Zgarb Aug 15 '17 at 20:21
5
\$\begingroup\$

Jelly, 9 8 bytes

ÆḌ߀Ẏ;€ȯ

Try it online!

Uses a similar technique to my Japt answer, and therefore runs very quickly on larger test cases.

How it works

ÆḌ߀Ẏ;€ȯ    Main link. Argument: n (integer)
ÆḌ          Yield the proper divisors of n.
       ȯ    If there are no divisors, return n. Only happens when n is 1.
  ߀        Otherwise, run each divisor through this link again. Yields
            a list of lists of Gozinta chains.
    Ẏ       Tighten; bring each chain into the main list.
     ;€     Append n to each chain.
\$\endgroup\$
4
\$\begingroup\$

Mathematica, 77 bytes

FindPath[Graph@Cases[Divisors@#~Subsets~{2},{m_,n_}/;m∣n:>m->n],1,#,#,All]&

Forms a Graph where the vertices are the Divisors of the input #, and the edges represent proper divisibility, then finds All paths from the vertex 1 to the vertex #.

\$\endgroup\$
  • 1
    \$\begingroup\$ Woah, this is pretty clever! \$\endgroup\$ – JungHwan Min Aug 15 '17 at 21:57
3
\$\begingroup\$

Jelly, 12 bytes

ŒPµḍ2\×ISµÐṀ

A monadic link accepting an integer and returning a list of lists of integers.

Try it online!

How?

We want all the sorted lists of unique integers between one and N such that the first is a one, the last is N, and all pairs divide. The code achieves this filter by checking the pair-wise division criteria is satisfied over the power-set of the range in question, but only picking those with maximal sums of incremental difference (the ones which both start with one and end with N will have a sum of incremental differences of N-1, others will have less).

ŒPµḍ2\×ISµÐṀ - Link: number N
ŒP           - power-set (implicit range of input) = [[1],[2],...,[N],[1,2],[1,3],...,[1,N],[1,2,3],...]
          ÐṀ - filter keep those for which the result of the link to the left is maximal:
  µ      µ   - (a monadic chain)
    2\       -   pairwise overlapping reduce with:
   ḍ         -     divides? (1 if so, 0 otherwise)
       I     -   increments  e.g. for [1,2,4,12] -> [2-1,4-2,12-4] = [1,2,8]
      ×      -   multiply (vectorises) (no effect if all divide,
             -                          otherwise at least one gets set to 0)
        S    -   sum         e.g. for [1,2,4,12] -> 1+2+8 = 11 (=12-1)
\$\endgroup\$
  • \$\begingroup\$ Wait there's n-wise overlapping reduce? :o how did I never see that :P I was using <slice>2<divisible>\<each> :P \$\endgroup\$ – HyperNeutrino Aug 15 '17 at 19:11
  • \$\begingroup\$ Using the newest change to Jelly's quicks, you can use Ɲ instead of `2` for 11 bytes. \$\endgroup\$ – Mr. Xcoder Jan 3 '18 at 8:30
3
\$\begingroup\$

Japt, 17 bytes

⬣ßX m+S+UR÷ª'1

Test it online!

Weirdly, generating the output as a string was way easier than generating it as an array of arrays...

Explanation

 ⬠£  ßX m+S+URà ·  ª '1
Uâq mX{ßX m+S+UR} qR ||'1   Ungolfed
                            Implicit: U = input number, R = newline, S = space
Uâ                          Find all divisors of U,
  q                           leaving out U itself.
    mX{         }           Map each divisor X to
       ßX                     The divisor chains of X (literally "run the program on X")
          m    R              with each chain mapped to
           +S+U                 the chain, plus a space, plus U.
                  qR        Join on newlines.
                     ||     If the result is empty (only happens when there are no factors, i.e. U == 1)
                       '1     return the string "1".
                            Otherwise, return the generated string.
                            Implicit: output result of last expression
\$\endgroup\$
  • \$\begingroup\$ So then does your approach avoid generating invalid chains then filtering them, as other approaches do? \$\endgroup\$ – Umbrella Aug 15 '17 at 19:09
  • \$\begingroup\$ @Umbrella Nope, it generates only the valid ones, one divisor at a time, hence why it works lightning-fast even on cases such as 12000 :-) \$\endgroup\$ – ETHproductions Aug 15 '17 at 19:12
  • \$\begingroup\$ Very nice use of recursion :) And I'm nicking that ¬ trick! :p \$\endgroup\$ – Shaggy Aug 18 '17 at 15:31
  • \$\begingroup\$ @Shaggy ¬ is one of the reasons why I've implemented a bunch of functions that are basically "do X given no arguments, or Y given a truthy argument" :P \$\endgroup\$ – ETHproductions Aug 18 '17 at 15:40
3
\$\begingroup\$

Mathematica, 60 bytes

Cases[Subsets@Divisors@#,x:{1,___,#}/;Divisible@@Reverse@{x}]&

Uses the undocumented multi-arg form of Divisible, where Divisible[n1,n2,...] returns True if n2∣n1, n3∣n2, and so on, and False otherwise. We take all Subsets of the list of Divisors of the input #, then return the Cases of the form {1,___,#} such that Divisible gives True for the Reversed sequence of divisors.

\$\endgroup\$
  • \$\begingroup\$ So, Divisible is basically a builtin for verifying a gozinta chain? \$\endgroup\$ – Umbrella Aug 16 '17 at 13:12
  • \$\begingroup\$ @Umbrella It doesn't check for proper divisibility. \$\endgroup\$ – ngenisis Aug 16 '17 at 15:21
3
\$\begingroup\$

Haskell, 51 bytes

f 1=[[1]]
f n=[g++[n]|k<-[1..n-1],n`mod`k<1,g<-f k]

Recursively find gozinta chains of proper divisors and append n.

Try it online!

\$\endgroup\$
  • \$\begingroup\$ I feel there should be extra credit for properly handling 1. Since we collectively concluded to exempt 1, could you save 10 bytes by removing that case? \$\endgroup\$ – Umbrella Aug 16 '17 at 13:16
  • \$\begingroup\$ @Umbrella 1 is not a special case for this algorithm, it is needed as base case for the recursion. On its own, the second defining equation can only return the empty list. \$\endgroup\$ – Christian Sievers Aug 16 '17 at 15:30
  • \$\begingroup\$ I see. My solution (yet unposted) uses [[1]] as a base also. \$\endgroup\$ – Umbrella Aug 16 '17 at 18:16
3
\$\begingroup\$

Haskell (Lambdabot), 92 85 bytes

x#y|x==y=[[x]]|1>0=(guard(mod x y<1)>>(y:).map(y*)<$>div x y#2)++x#(y+1)
map(1:).(#2)

Needs Lambdabot Haskell since guard requires Control.Monad to be imported. Main function is an anonymous function, which I'm told is allowed and it shaves off a couple of bytes.

Thanks to Laikoni for saving seven bytes.

Explanation:

Monads are very handy.

x # y

This is our recursive function that does all the actual work. x is the number we're accumulating over (the product of the divisors that remain in the value), and y is the next number we should try dividing into it.

 | x == y = [[x]]

If x equals y then we're done recursing. Just use x as the end of the current gozinta chain and return it.

 | 1 > 0 =

Haskell golf-ism for "True". That is, this is the default case.

(guard (mod x y < 1) >>

We're operating inside the list monad now. Within the list monad, we have the ability to make multiple choices at the same time. This is very helpful when finding "all possible" of something by exhaustion. The guard statement says "only consider the following choice if a condition is true". In this case, only consider the following choice if y divides x.

(y:) . map (y *) <$> div x y#2)

If y does divide x, we have the choice of adding y to the gozinta chain. In this case, recursively call (#), starting over at y = 2 with x equal to x / y, since we want to "factor out" that y we just added to the chain. Then, whatever the result from this recursive call, multiple its values by the y we just factored out and add y to the gozinta chain officially.

++

Consider the following choice as well. This simply adds the two lists together, but monadically we can think of it as saying "choose between doing this thing OR this other thing".

x # (y + 1)

The other option is to simply continue recursing and not use the value y. If y does not divide x then this is the only option. If y does divide x then this option will be taken as well as the other option, and the results will be combined.

map (1 :) . (# 2)

This is the main gozinta function. It begins the recursion by calling (#) with its argument. A 1 is prepended to every gozinta chain, because the (#) function never puts ones into the chains.

\$\endgroup\$
  • 1
    \$\begingroup\$ Great explanation! You can save some bytes by putting the pattern guards all in one line. mod x y==0 can be shortened to mod x y<1. Because anonymous functions are allowed, your main function can be written pointfree as map(1:).(#2). \$\endgroup\$ – Laikoni Aug 17 '17 at 10:39
3
\$\begingroup\$

Haskell, 107 100 95 bytes

f n=until(all(<2).map head)(>>=h)[[n]]
h l@(x:_)|x<2=[l]|1<2=map(:l)$filter((<1).mod x)[1..x-1]

Maybe there is a better termination condition (tried something like

f n=i[[n]]
i x|g x==x=x|1<2=i$g x
g=(>>=h)

but it's longer). The check for 1 seems prudent as scrubbing repeat 1s or duplicates (nub not in Prelude) is more bytes.

Try it online.

\$\endgroup\$
  • 3
    \$\begingroup\$ (>>=h) for (concatMap h) \$\endgroup\$ – Michael Klein Aug 16 '17 at 0:12
  • \$\begingroup\$ 95 bytes \$\endgroup\$ – Cristian Lupascu Aug 18 '17 at 11:29
  • \$\begingroup\$ Holy crap am I stupid about u ... \$\endgroup\$ – Leif Willerts Aug 18 '17 at 17:42
3
\$\begingroup\$

JavaScript (Firefox 30-57), 73 bytes

f=n=>n>1?[for(i of Array(n).keys())if(n%i<1)for(j of f(i))[...j,n]]:[[1]]

Conveniently n%0<1 is false.

\$\endgroup\$
2
\$\begingroup\$

Jelly, 17 bytes

ḊṖŒP1ppWF€ḍ2\Ạ$Ðf

Try it online!

\$\endgroup\$
  • \$\begingroup\$ That was impressively fast. Your result for 1 is unexpected, though. I haven't managed to find a definitive result for 1, but I assumed it was [[1]]. I can't say for sure that [1,1] is incorrect except that all other results are increasing sequences. Thoughts? \$\endgroup\$ – Umbrella Aug 15 '17 at 17:54
  • \$\begingroup\$ @Umbrella You might want to let the answers do anything for 1. \$\endgroup\$ – Mr. Xcoder Aug 15 '17 at 17:56
  • \$\begingroup\$ @Umbrella If it's a problem I can fix it for +2 (replace ;€ with ;Q¥€). \$\endgroup\$ – Erik the Outgolfer Aug 15 '17 at 18:01
2
\$\begingroup\$

Mathematica, 104 bytes

(S=Select)[Rest@S[Subsets@Divisors[t=#],FreeQ[#∣#2&@@@Partition[#,2,1],1>2]&],First@#==1&&Last@#==t&]&
\$\endgroup\$
  • \$\begingroup\$ FreeQ[...] can become And@@BlockMap[#∣#2&@@#&,#,2,1] \$\endgroup\$ – JungHwan Min Aug 15 '17 at 21:49
  • \$\begingroup\$ very nice! but I get an extra message DeveloperPartitionMap::nlen: -- Message text not found -- >>` why is that? \$\endgroup\$ – J42161217 Aug 15 '17 at 21:57
  • \$\begingroup\$ BlockMap uses the Developer`PartitionMap function internally, but since it's a developer function, it has no error messages. The error is caused by the lists that have 1 or 0 elements, which you cannot make 2-partitions with. \$\endgroup\$ – JungHwan Min Aug 15 '17 at 22:16
2
\$\begingroup\$

Mathematica, 72 bytes

Cases[Subsets@Divisors@#,{1,___,#}?(And@@BlockMap[#∣#2&@@#&,#,2,1]&)]&

Explanation

Divisors@#

Find all divisors of the input.

Subsets@ ...

Generate all subsets of that list.

Cases[ ... ]

Pick all cases that match the pattern...

{1,___,#}

Beginning with 1 and ending with <input>...

?( ... )

and satisfies the condition...

And@@BlockMap[#∣#2&@@#&,#,2,1]&

The left element divides the right element for all 2-partitions of the list, offset 1.

\$\endgroup\$
2
\$\begingroup\$

TI-BASIC, 76 bytes

Input N
1→L1(1
Repeat Ans=2
While Ans<N
2Ans→L1(1+dim(L1
End
If Ans=N:Disp L1
dim(L1)-1→dim(L1
L1(Ans)+L1(Ans-(Ans>1→L1(Ans
End

Explanation

Input N                       Prompt user for N.
1→L1(1                        Initialize L1 to {1}, and also set Ans to 1.

Repeat Ans=2                  Loop until Ans is 2.
                              At this point in the loop, Ans holds the
                              last element of L1.

While Ans<N                   While the last element is less than N,
2Ans→L1(1+dim(L1              extend the list with twice that value.
End

If Ans=N:Disp L1              If the last element is N, display the list.

dim(L1)-1→dim(L1              Remove the last element, and place the new
                              list size in Ans.

L1(Ans)+L1(Ans-(Ans>1→L1(Ans  Add the second-to-last element to the last
                              element, thereby advancing to the next
                              multiple of the second-to-last element.
                              Avoid erroring when only one element remains
                              by adding the last element to itself.

End                           When the 1 is added to itself, stop looping.

I could save another 5 bytes if it's allowed to exit with an error instead of gracefully, by removing the Ans>1 check and the loop condition. But I'm not confident that's allowed.

\$\endgroup\$
  • \$\begingroup\$ Did you type this into your calculator? Because that's unexpected and somewhat impressive. \$\endgroup\$ – Umbrella Aug 16 '17 at 13:13
  • \$\begingroup\$ Yep! The tricky part about TI-BASIC is that there are only global variables, so I had to effectively use the list itself as my recursion stack. \$\endgroup\$ – calc84maniac Aug 16 '17 at 13:31
2
\$\begingroup\$

Mathematica 86 77 Bytes

Select[Subsets@Divisors@#~Cases~{1,___,#},And@@BlockMap[#∣#2&@@#&,#,2,1]&]&

Brute force by the definition.

Wishing there was a shorter way to do pairwise sequential element comparison of a list.

Thanks to @Jenny_mathy and @JungHwanMin for suggestions saving 9 bytes

\$\endgroup\$
  • 1
    \$\begingroup\$ you can use FreeQ[#∣#2&@@@Partition[#,2,1],1>2]&] (as the second argument) to go to 82 bytes \$\endgroup\$ – J42161217 Aug 15 '17 at 21:18
  • \$\begingroup\$ @Jenny_mathy Or better, And@@BlockMap[#∣#2&@@#&,#,2,1] \$\endgroup\$ – JungHwan Min Aug 15 '17 at 21:38
1
\$\begingroup\$

Husk, 17 16 bytes

-1 byte, thanks to Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

Try it online!

\$\endgroup\$
  • \$\begingroup\$ Short, but slow. I put 50 in the input and it timed out. What is the gist of your approach? \$\endgroup\$ – Umbrella Aug 15 '17 at 18:11
  • \$\begingroup\$ It essentially tries all possible chains and picks the ones that match the spec \$\endgroup\$ – H.PWiz Aug 15 '17 at 18:12
  • \$\begingroup\$ @Umbrella TIO has a 60-second timeout, it's not the program's fault. \$\endgroup\$ – Erik the Outgolfer Aug 15 '17 at 18:13
  • \$\begingroup\$ o`:⁰:1 can be `Je1⁰ \$\endgroup\$ – Zgarb Aug 15 '17 at 18:24
  • \$\begingroup\$ @Zgarb Once again... \$\endgroup\$ – H.PWiz Aug 15 '17 at 18:25
0
\$\begingroup\$

PHP 147 141

Edited to remove a redundant test

function g($i){$r=[[1]];for($j=2;$j<=$i;$j++)foreach($r as$c)if($j%end($c)<1&&$c[]=$j)$r[]=$c;foreach($r as$c)end($c)<$i?0:$R[]=$c;return$R;}

Explained:

function g($i) {

15 chars of boilerplate :(

    $r = [[1]];

Init the result set to [[1]] as every chain starts with 1. This also leads to support for 1 as an input.

    for ($j = 2; $j <= $i; $j++) {
        foreach ($r as $c) {
            if ($j % end($c) < 1) {
                $c[] = $j;
                $r[] = $c;
            }
        }
    }

For every number from 2 to $i, we're going to extend each chain in our set by the current number if it gozinta, then, add the extended chain to our result set.

    foreach ($r as $c) {
        end($c) < $i ? 0 : $R[] = $c;
    }

Filter out our intermediate chains that didn't make it to $i

    return $R;
}

10 chars of boilerplate :(

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

Mathematica

f[1] = {{1}};
f[n_] := f[n] = Append[n] /@ Apply[Join, Map[f, Most@Divisors@n]]

Answer is cached for additional calls.

\$\endgroup\$
  • 1
    \$\begingroup\$ Welcome to the site! This is a code-golf so you should include your byte count and in addition attempt to remove all extra whitespace, which I suspect you have some. \$\endgroup\$ – Wheat Wizard Jun 1 '18 at 12:45

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.