26
\$\begingroup\$

Introduction

The telephone numbers or involution numbers are a sequence of integers that count the ways \$n\$ telephone lines can be connected to each other, where each line can be connected to at most one other line. These were first studied by Heinrich August Rothe in 1800, when he gave a recurrence equation where they may be calculated. It is sequence A000085 in the OEIS.

Some help

  • The first terms of the sequence are \$1, 1, 2, 4, 10, 26, 76, 232, 764, 2620, 9496\$
  • It can be described by the recurrence relation \$T(n)=T(n-1)+(n-1)T(n-2)\$ (starting from \$n=0\$)
  • It can be expressed exactly by the summation \$T(n)=\sum\limits_{k=0}^{\lfloor n/2 \rfloor}{n\choose 2k}(2k-1)!!=\sum\limits_{k=0}^{\lfloor n/2 \rfloor}\frac{n!}{2^k(n-2k)!k!}\$ (starting from \$n=0\$)
  • There are other ways to get the telephone numbers which can be found on the Wikipedia and OEIS pages

Challenge

Write a program or function which returns the \$n^{th}\$ telephone number.

I/O examples

(0 based indexing)
input --> output

0  -->            1
10 -->         9496
16 -->     46206736
22 --> 618884638912

Rules

  • Input will be the index of the sequence
  • The index origin can be anything
  • As the numbers can get very large, you only need to support numbers as large as your language can handle
  • Standard I/O rules apply
  • No standard loopholes
  • This is so shortest code in bytes wins
\$\endgroup\$

22 Answers 22

13
\$\begingroup\$

Oasis, 7 6 5 bytes

àn*+1

Try it online!

# to compute the nth telephone number f(n):
à      # push the telephone numbers f(n-1) and f(n-2)
 n     # push n
  *    # multiply: n * f(n-2)
   +   # add: n * f(n-2) + f(n-1)

1      # base case: f(0) = 1
\$\endgroup\$
  • \$\begingroup\$ 5 bytes in what charset? in UTF-8 the à character is 2 bytes, so it's 6 bytes in UTF-8. - is it Windows-1252 perhaps? \$\endgroup\$ – hanshenrik Jan 23 at 15:23
  • \$\begingroup\$ @hanshenrik 5 bytes in Oasis' charset, which is certainly not UTF-8. I'm not sure what exactly that charset is, but I don't see why that would matter. You can see all available characters here, maybe you can guess the charset from that. \$\endgroup\$ – Grimmy Jan 23 at 17:11
  • \$\begingroup\$ can you provide a base64 or hex encoded copy of the source code? \$\endgroup\$ – hanshenrik Jan 23 at 17:21
  • 1
    \$\begingroup\$ @hanshenrik gosh, I'd have to actually download Oasis for that. I only ever used it through TIO, and TIO doesn't provide that functionality. But TIO does tell you the byte count, and that's what matters for code golf, right? \$\endgroup\$ – Grimmy Jan 23 at 17:24
  • \$\begingroup\$ well just to be sure i checked the source code (specifically line 620), it's Windows-1252 indeed, which makes it 5 bytes. and hex-encoded it's e06e2a2b31 \$\endgroup\$ – hanshenrik Jan 23 at 17:34
20
\$\begingroup\$

Python, 33 bytes

f=lambda n:n<2or~-n*f(n-2)+f(n-1)

Try it online!

Uses the recursive formula.

\$\endgroup\$
9
\$\begingroup\$

cQuents, 10 bytes

=1:Z+Y($-2

1-indexed.

Try it online!

Explanation

=1           first term in sequence is 1
  :          given n, output nth term in sequence (1-indexed)
             each term is
   Z+                     (n-1) term +
     Y                                 (n-2) term *    
      ($-2                                          (index - 2)
\$\endgroup\$
8
\$\begingroup\$

Jelly, 6 bytes

Œ!ỤƑ€S

A monadic Link accepting a non-negative integer which yields a positive integer.

Try it online! Or see the first 10 (n=10 is too slow)

How?

Builds all permutations of [1...n] (or if n=0 just [[]]) and counts the number which are involutions.

Œ!ỤƑ€S - Link: integer, n     e.g.  0        3
Œ!     - all permutations          [[]]     [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
    €  - for each:
   Ƒ   -   is invariant under:
  Ụ    -     grade                ( []       [1,2,3] [1,3,2] [2,1,3] [3,1,2] [2,3,1] [3,2,1] )
       -   }                        [1]     [1,      1,      1,      0,      0,      1]
     S - sum                        1       4
\$\endgroup\$
  • \$\begingroup\$ I tried doing something like this in 05AB1E, but it ended up longer than the recurrence relation. Really clever use of "grade"! \$\endgroup\$ – Grimmy Jan 21 at 13:09
7
\$\begingroup\$

TI-BASIC, 28 22 bytes

∑((Ans nCr (2K))(2K)!/(2^KK!),K,0,int(.5Ans

Input is n in Ans.
Output is the nth telephone number.

I was going to use the first formula mentioned in the challenge, but testing it resulted in ERROR: OVERFLOWs even on smaller numbers because TI-BASIC handles n!! as two successive factorials instead of a double factorial.
At least it has a builtin for summation notation!

Update:

I found that \$(2k-1)!!=\frac{(2k)!}{2^kk!}\$, so i replaced the function i was using to \${{n}\choose{2k}}\frac{(2k)!}{2^kk!}\$, which is represented as (Ans nCr (2K))(2K)!/(2^KK!) in TI-BASIC.

Explanation:

∑((Ans nCr (2K))(2K)!/(2^KK!)               ;sum the equation mentioned above
                             ,K             ;using K as the loop variable
                               ,0           ;starting at 0
                                 ,int(.5Ans ;and ending at the floor of half of the input
                                            ;leave the result in Ans
                                            ;implicit print of Ans

Examples:

10:prgmCDGF26
            9496
5:prgmCDGF26
              26

Note: TI-BASIC is a tokenized language. Character count does not equal byte count.

\$\endgroup\$
6
\$\begingroup\$

JavaScript (ES6), 25 bytes

0-indexed. Uses the recurrence relation.

f=n=>n<2||f(--n)+n*f(n-1)

Try it online!

\$\endgroup\$
4
\$\begingroup\$

05AB1E, 12 8 bytes

-4 bytes by porting Stephen's cQuent answer

1λèsN<*+

Try it online!

\$\endgroup\$
4
\$\begingroup\$

Haskell, 29 bytes

f n|n<2=1|m<-n-1=f m+m*f(n-2)

Try it online!

Implements the recursive formula.

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

Perl 6, 26 bytes

{{(1,1,++$×*+*...*)[$_]}}

Try it online!

\$\endgroup\$
  • \$\begingroup\$ Why does this require two sets of {}? The behavior of {(1,1,++$×*+*...*)[$_]} is different and I don't understand why. \$\endgroup\$ – SirBogman Jan 26 at 20:38
  • 1
    \$\begingroup\$ @SirBogman With out the double braces, the state variable $ isn't reset across multiple runs of the function. The inner braces create a separate lexical scope for $ causing it to be reset whenever the function is run. \$\endgroup\$ – nwellnhof Jan 27 at 13:13
3
\$\begingroup\$

C (gcc), 40 bytes

long f(long n){n=n<2?1:f(--n)+n*f(n-1);}

Try it online!

Merely copied from @Arnauld answer

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

Python 3, 81 \$\cdots\$ 57 56 bytes

def f(n):
 a=b=i=1
 while i<n:a,b=a+i*b,a;i+=1
 return a

Try it online!

Uses 0 based indexing and implements the recursive formula.

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

J, 25 bytes

($:+]*$:@<:)@<:`1:@.(<&2)

Try it online!

$: is J's recursion operator, so this is a fairly straightforward impl of the recursive def.

I tried a couple other approaches (including using ^: power of operator) but wasn't able to get shorter than this.

Am curious if anyone can improve it...

\$\endgroup\$
  • \$\begingroup\$ Hint: generating function \$\endgroup\$ – user41805 Jan 21 at 12:29
  • \$\begingroup\$ I actually tried this approach with the t. adverb but got a domain error on the Wikipedia generating function \$\endgroup\$ – Jonah Jan 21 at 12:47
  • 1
    \$\begingroup\$ Yeah I found J being restrictive too, but messing around gave (^*^@(]*-:))t.*! which works tio.run/##y/r/P83WSiNOK85BI1ZL10pTs0RPSxEoqJCpZ2RQAQA \$\endgroup\$ – user41805 Jan 21 at 12:50
  • \$\begingroup\$ Interesting... ty! Feel free to post as separate answer, otherwise Ill update mine in a few hours when Im back on my laptop \$\endgroup\$ – Jonah Jan 21 at 12:54
  • \$\begingroup\$ I'll leave it to you. And I forgot, ]*-: can obviously become *-: \$\endgroup\$ – user41805 Jan 21 at 13:05
2
\$\begingroup\$

PHP, 48 bytes

function f($n){return$n<2?1:f(--$n)+$n*f($n-1);}

Try it online!

Implementation of the recursive function.

Original version: 54 bytes (port of @Noodle9 answer):

for($i=$j=1;++$n<$argn;$j=$k){$k=$i;$i+=$n*$j;}echo$i;

Try it online!

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

Mathematica 46 42 bytes

f=2^(#/2)HypergeometricU[-#/2,.5,-.5]I^-#&

Try it online!

Thanks to mabel for helping me shave 4 bytes by using what I think is an anonymous function.

As seen in https://www.wolframalpha.com/input/?i=OEIS+A000085 and http://mathworld.wolfram.com/ConfluentHypergeometricFunctionoftheSecondKind.html

\$\endgroup\$
  • 1
    \$\begingroup\$ hi! you may want to add a link to Try It Online so other people can test out your code. (I've also saved a few trivial bytes) \$\endgroup\$ – mabel Jan 22 at 21:17
  • \$\begingroup\$ @mabel Ty for the suggestion and the 4 bytes off ;) \$\endgroup\$ – RGS Jan 23 at 0:43
  • \$\begingroup\$ no problem @RGS \$\endgroup\$ – mabel Jan 23 at 7:21
2
\$\begingroup\$

Red, 53 bytes

f: func[n][either 1 > n: n - 1[1][n *(f n - 1)+ f n]]

Try it online!

\$\endgroup\$
  • \$\begingroup\$ @RGS Oh, I totally forgot that the function is recusrsive! You're right, I need to include f: to the bytecount. Thanks! \$\endgroup\$ – Galen Ivanov Jan 23 at 8:41
  • \$\begingroup\$ don't worry ^^ I'm just vouching for clarity :) \$\endgroup\$ – RGS Jan 23 at 8:47
1
\$\begingroup\$

Charcoal, 20 bytes

⊞υ¹FN⊞υ⁺§υι×ι§υ⊖ιI⊟υ

Try it online! Link is to verbose version of code. Uses the recurrence relation. Explanation:

⊞υ¹

T(0)=1

FN

Loop n times.

⊞υ⁺§υι×ι§υ⊖ι

T(i+1)=T(i)+iT(i-1)

I⊟υ

Output T(n).

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

Keg, 21 bytes

:1≤[_1|;:@Tƒ^:;@Tƒ*+]

Try it online!

Simply implements the formula in a recursive manner. The footer is mainly for testing purposes

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

Retina 0.8.2, 80 bytes

.+
$*_;;_;
{`^_(_*;)(_*;_+)
$1_$2,$2
+`(,_*)_(;_+;(_*))|,
$3$1$2
^;_*;(_*).*
$.1

Try it online! Explanation:

.+
$*_;;_;

Initialise the work area with n, i=0, and T=[1] (note that the list indices are reversed, so that the first element of T is T[i] and the last is T[0]) converted to unary.

{`

Loop n times (actually until the buffer stops changing, but see below).

^_(_*;)(_*;_+)
$1_$2,$2

Decrement n, increment i, and make extra copies of i and T[i].

+`

Repeat i times.

(,_*)_(;_+;(_*))|,
$3$1$2

Decrement the copy of i and add T[i-1] to the copy of T[i], stopping when the copy reaches zero by deleting the , entirely, causing the repeat to terminate. The result is therefore T[i+1]=T[i]+iT[i-1].

^;_*;(_*).*
$.1

When n is zero, replace the work area with T[i] converted to decimal. This causes the loop to terminate as the stages can no longer match.

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

Japt, 28 26 bytes

_pZÌ+(ZÊÉ *ZgJÑ}g´U1õ ï)gJ

Try it

pZÌ+(ZÊÉ *ZgJÑ   make sequence with next element from previous sequence

_    ...  }g´U    repeat input -1 times 
  1õ ï)          starting with [[1,1]]
       gJ        implicit output last element of resulting sequence
\$\endgroup\$
1
\$\begingroup\$

GolfScript, 16 bytes

This is inspired by the Fibonacci GolfScript program.

~,1.@{)*1$+\}/\;

Try it online!

Explanation

~,               # Generate exclusive range from input to 0
  1.             # Make 2 copies of 1
    @            # Make the each target on the top
     {      }/   # Foreach over the range
      )          # Increment the current item
       *         # Multiply top by the current item
        1$+      # And add by the second-to-top
           \     # Swap items
              \; # Swap & discard the bottom item
\$\endgroup\$
1
\$\begingroup\$

Elm, 45 bytes

f n = if n<2 then 1 else (n-1)*f(n-2)+f(n-1)

Try it online!

Implementation of the recursive function.

\$\endgroup\$
0
\$\begingroup\$

k4, 53 bytes

{+/{*/[1+!x]*%*/[y#2]**/*/'1+(!x-2*y;!y)}[x]'!1+_x%2}

   {                                    }[x]'!1+_x%2 /pass inner lambda 2 args - x and each (') enumerate (!) 1+floor float-div 2
                             (!x-2*y;!y)             /enumerate
                           1+                        /add 1 to both list items
                        */'                          /multiply over each - this gives both denominator factorials
                      */                             /multiply them
              */[y#2]                                /make list of 2s of y-length and multiply over - gives y^2
                     *                               /multiply left and right args
             %                                       /reciprocal
    */[1+!x]                                         /x factorial
 +/                                                  /sum

examples:

  {+/{*/[1+!x]*%*/*/[y#2],*/'1+(!x-2*y;!y)}[x]'!1+_x%2}'[0 3 10 14]
1 4 9496 2390480f
\$\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.