26
\$\begingroup\$

This challenge will give you an integer n, and ask you to count the number of positive integer sequences \$S = (a_1, a_2, \dots, a_t)\$ such that

  1. \$a_1 + a_2 + \cdots + a_t = n\$, and
  2. \$\displaystyle \sqrt{a_1+\sqrt{a_2 + \cdots + \stackrel{\vdots}{\sqrt{a_t}}}} \$ is an integer.

Example

If n = 14, then there are 8 such sequences:

  • \$\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{3+\sqrt{1}}}}}}} = 2\$
  • \$\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{2+\sqrt{4}}}}}} = 2\$
  • \$\sqrt{1+\sqrt{7+\sqrt{2+\sqrt{3+\sqrt{1}}}}} = 2\$
  • \$\sqrt{2+\sqrt{1+\sqrt{7+\sqrt{3+\sqrt{1}}}}} = 2\$
  • \$\sqrt{2+\sqrt{2+\sqrt{1+\sqrt{8+\sqrt{1}}}}} = 2\$
  • \$\sqrt{1+\sqrt{7+\sqrt{2+\sqrt{4}}}} = 2\$
  • \$\sqrt{2+\sqrt{1+\sqrt{7+\sqrt{4}}}} = 2\$
  • \$\sqrt{2+\sqrt{2+\sqrt{1+\sqrt{9}}}} = 2\$

(In this example, all of the nested square root expressions are equal to 2, but in general, this may not be the case.)

Pairs \$(n,(a(n))\$ for \$n \leq 25\$:

(1,1),(2,0),(3,0),(4,2),(5,0),(6,2),(7,0),(8,2),(9,2),(10,4),(11,2),(12,6),(13,2),(14,8),(15,4),(16,14),(17,6),(18,20),(19,8),(20,28),(21,14),(22,44),(23,20),(24,66),(25,30)

Your code must be robust against floating-point errors, that is it must work for arbitrarily large inputs, in principle.

Since this is a challenge, the shortest code wins.


(This is now on the On-Line Encyclopedia of Integer Sequences as A338271. Sequence A338268 has been added too, based on Bubbler's \$f\$ function.)

\$\endgroup\$
8
  • 6
    \$\begingroup\$ Answers to this may fail due to floating-point issues, is that acceptable, so long as the method/algorithm is sound? \$\endgroup\$ Oct 19, 2020 at 22:52
  • 5
    \$\begingroup\$ @PeterKagey That seems very difficult to do, probably requiring a custom floating point type. I think caird coinheringaahing's suggestion makes much more sense. \$\endgroup\$ Oct 19, 2020 at 22:57
  • 8
    \$\begingroup\$ @RedwolfPrograms—my implementation doesn't use any floating points, and while it's not golfed, it wasn't especially tricky to implement. (See, for example, stackoverflow.com/a/15391420/3512049) \$\endgroup\$ Oct 19, 2020 at 22:59
  • 5
    \$\begingroup\$ Not helpful for golf, but: Let \$ G = (V,E)\$ be the graph with \$0,1,\ldots,\infty\$ as vertices and associate a directed edge between \$V_a\$ and \$V_b\$ of integer weight \$w\$ if \$V_b^2 = V_a + w\$. Then \$a(n)\$ is the number of walks on the graph of total length \$n\$ starting at the zero vertex. \$\endgroup\$
    – Sisyphus
    Oct 20, 2020 at 0:36
  • 8
    \$\begingroup\$ So, I guess the collective brain of code golg helped you again in finding more terms for your new sequence... oeis.org/draft/A338271 \$\endgroup\$
    – ZaMoC
    Oct 20, 2020 at 6:54

10 Answers 10

25
\$\begingroup\$

APL (Dyalog Unicode), 39 bytes

+/⊢{∨/⍺⍵<⍵0:0⋄⍺=0:1⋄+/∊∇¨/⍺(⍵*2)-⊂⍳⍺}¨⍳

Try it online!

A tacit function containing an inner dfn to use recursion. Does not use floating point numbers at all.

How it works

First of all, observe that

$$ \displaystyle \sqrt{a_1+\sqrt{a_2 + \cdots + \stackrel{\vdots}{\sqrt{a_t}}}} \le \cdots \le \sqrt{a_1+a_2 + \cdots + a_t} \le a_1+a_2 + \cdots + a_t = n $$

and this holds for all suffixes of any given sequence of positive integers.

Let's define a function \$f(x,y)\$ as the number of sequences where the sum is \$x\$ and the "root sum" is \$y\$. Then the following holds:

$$ \begin{align} f(0, 0) &= 1 \\ f(0, y) &= 0, \qquad 0 < y \\ f(x, y) &= 0, \qquad x < y \text{ or } y < 0 \\ f(x, y) &= \sum_{i=1}^{x}{f(x-i, y^2-i)} \end{align} $$

Then the desired result is the sum \$\sum_{i=1}^{n}{f(n,i)}\$.

\$\endgroup\$
12
\$\begingroup\$

Python 3, 67 bytes

This builds all sequences that sum to \$n\$ and slightly higher and counts those that exactly sum to \$n\$.

f=lambda n,k=0:(n==0)+sum(f(n-d*d+k,d)for d in range(n-~k)if d*d>k)

Try it online!

This approach is based on the observation that \$\sqrt x\$ can only be an integer if \$x\$ is an integer. This means, when building a sequence right to left, we always have to make sure to complete to a perfect square.

At every step \$\sqrt{a_i+k}\$, \$a_i+k = d^2\$ for some positive \$d\$ with \$0 \lt d^2-k \le n'\$, where \$n'\$ is the remaining integer at the current step. To check every possible square, \$d\$ needs to be tested up to \$\lfloor\sqrt{n'+k}\rfloor\ \le n+k\$.

In the code we count the number of times \$n'=0\$ is exactly reached, by summing all results and adding n==0. If n gets negative, range(n-~k) will eventually be empty, which will cause the recursion to stop.

This seems to be currently the fastest approach, and with some added memoization this gets really fast: First 1000 values

With a small modification the sequences can be printed:

f=lambda n,k=0,*a:(n==0!=print(a))+sum(f(n-d*d+k,d,d*d-k,*a)for d in range(n-~k)if d*d>k)

Try it online!

\$\endgroup\$
2
  • \$\begingroup\$ could n-~k be changed to 3*n? \$\endgroup\$ Oct 20, 2020 at 8:50
  • 1
    \$\begingroup\$ No that won't work. Consider n=65: In the sequence \$\sqrt{1+\sqrt{64}}\$ on the second iteration n=1, k=8, we need to consider d=3, which is not in range(3*1). Such counterexamples exist for any a*n. Try it online! \$\endgroup\$
    – ovs
    Oct 20, 2020 at 8:58
6
\$\begingroup\$

CP-1610 machine code, 31 DECLEs1 ≈ 39 bytes2

1. A CP-1610 opcode is encoded with a 10-bit value (0x000 to 0x3FF), known as a 'DECLE'.
2. As per the exception described in this meta answer, the exact score is 38.75 bytes (310 bits)


This is an implementation with only integer additions, subtractions and comparisons.

A routine taking the input in R1 and returning the result in R3.

1DB         |         CLRR    R3
1C0         |         CLRR    R0
275         | @@rec   PSHR    R5
089         |         TSTR    R1
20C 001     |         BNEQ    @@notZ
00B         |         INCR    R3
272         | @@notZ  PSHR    R2
1D2         |         CLRR    R2
110         | @@loop  SUBR    R2,     R0
012         |         DECR    R2
110         |         SUBR    R2,     R0
148         |         CMPR    R1,     R0
20E 00E     |         BGT     @@done
080         |         TSTR    R0
226 008     |         BLE     @@loop
270         |         PSHR    R0
271         |         PSHR    R1
101         |         SUBR    R0,     R1
090         |         MOVR    R2,     R0
004 148 040 |         CALL    @@rec
2B1         |         PULR    R1
2B0         |         PULR    R0
220 013     |         B       @@loop
2B2         | @@done  PULR    R2
2B7         |         PULR    R7

Full commented test code

        ROMW    10                ; use 10-bit ROM width
        ORG     $4800             ; map this program at $4800

PNUM    QEQU    $18C5             ; EXEC routine: print a number

        ;; ------------------------------------------------------------- ;;
        ;;  main code                                                    ;;
        ;; ------------------------------------------------------------- ;;
main    PROC

        SDBD                      ; set up an interrupt service routine
        MVII    #isr,   R0        ; to do some minimal STIC initialization
        MVO     R0,     $100
        SWAP    R0
        MVO     R0,     $101

        EIS                       ; enable interrupts

        MVII    #$200,  R3        ; R3 = backtab pointer
        CLRR    R1                ; R1 = number to test

@@loop  INCR    R1                ; increment R1
        PSHR    R1                ; save R1 & R3 on the stack
        PSHR    R3
        CALL    func              ; invoke our routine
        MOVR    R3,     R1        ; save the result in R1
        PULR    R3                ; restore R3
        CALL    print             ; print R1

        PULR    R1                ; restore R1
        CMPI    #28,    R1        ; go on as long as R1 is less than 28
        BLT     @@loop

        DECR    R7                ; done: loop forever

        ENDP

        ;; ------------------------------------------------------------- ;;
        ;;  prints the result of a test case                             ;;
        ;; ------------------------------------------------------------- ;;
print   PROC

        PSHR    R5                ; save the return address on the stack

        MOVR    R1,     R0        ; R0 = number to print
        MVII    #4,     R1        ; R1 = number of digits
        MOVR    R3,     R4        ; R4 = backtab pointer
        ADDI    #5,     R3        ; advance by 5 characters for the next one
        PSHR    R3                ; save R3
        CLRR    R3                ; R3 = attributes (black)
        CALL    PNUM              ; invoke the EXEC routine
        PULR    R3                ; restore R3

        PULR    R7                ; return

        ENDP

        ;; ------------------------------------------------------------- ;;
        ;;  ISR                                                          ;;
        ;; ------------------------------------------------------------- ;;
isr     PROC

        MVO     R0,     $0020     ; enable display
        MVI     $0021,  R0        ; colorstack mode

        CLRR    R0
        MVO     R0,     $0030     ; no horizontal delay
        MVO     R0,     $0031     ; no vertical delay
        MVO     R0,     $0032     ; no border extension
        MVII    #$D,    R0
        MVO     R0,     $0028     ; light-blue background
        MVO     R0,     $002C     ; light-blue border

        JR      R5                ; return from ISR

        ENDP

        ;; ------------------------------------------------------------- ;;
        ;;  our routine                                                  ;;
        ;; ------------------------------------------------------------- ;;
func    PROC

        CLRR    R3                ; R3 = counter for the final result
        CLRR    R0                ; start with R0 = 0

@@rec   PSHR    R5                ; this is the recursive entry point

        TSTR    R1                ; if R1 is equal to 0 ...
        BNEQ    @@notZ

        INCR    R3                ; ... increment R3

@@notZ  PSHR    R2                ; save R2 on the stack
        CLRR    R2                ; start with R2 = 0

@@loop  SUBR    R2,     R0        ; subtract R2 from R0
        DECR    R2                ; decrement R2
        SUBR    R2,     R0        ; subtract R2 from R0
        CMPR    R1,     R0        ; abort if R0 is greater than R1
        BGT     @@done

        TSTR    R0                ; skip the recursive call if R0 <= 0
        BLE     @@loop

        PSHR    R0                ; save R0 and R1 on the stack
        PSHR    R1
        SUBR    R0,     R1        ; subtract R0 from R1
        MOVR    R2,     R0        ; move R2 to R0
        CALL    @@rec             ; recursive call
        PULR    R1                ; restore R0 and R1
        PULR    R0
        B       @@loop            ; keep going

@@done  PULR    R2                ; this is either the end of a recursive
        PULR    R7                ; call or the end of the routine

        ENDP

Output

Below are a(1) to a(28).

output

screenshot from jzIntv

\$\endgroup\$
7
  • \$\begingroup\$ How does it print like that? I've never seen anything like it. \$\endgroup\$
    – Someone
    Oct 21, 2020 at 12:23
  • 3
    \$\begingroup\$ @Someone This code is running on an Intellivision, a console from the early 80's era. :-) The screen resolution is 160x96. \$\endgroup\$
    – Arnauld
    Oct 21, 2020 at 12:29
  • \$\begingroup\$ How are these numbers printing? Is each number above or to the left or to some other direction of its value? Above, right? \$\endgroup\$
    – Someone
    Oct 21, 2020 at 12:31
  • \$\begingroup\$ @Someone The numbers are printed the usual way, from left to right and top to bottom. What I'm doing is equivalent to printf("%4d ", n); in C, but on a very small screen. \$\endgroup\$
    – Arnauld
    Oct 21, 2020 at 12:42
  • 1
    \$\begingroup\$ @Someone what you see is only the number of sequences. n is not printed, but given by the position. n=1 is in the top left corner, n=4 in the top right, n=25 in the bottom left, and n=28 in the bottom right. \$\endgroup\$ Oct 22, 2020 at 12:42
6
\$\begingroup\$

Wolfram Language (Mathematica), 56 50 bytes

If[a=##-i i;0<a<#,a~#0~i,1-Sign@a]~Sum~{i,√+##}&

Try it online!

\$\endgroup\$
5
\$\begingroup\$

05AB1E, 20 19 bytes

Åœ€œ€`ÙʒÅ«t+}н§Å²}g

Brute-force approach, so very slow. Times out for \$\geq10\$.

Try it online or verify the first 9 test cases.

Explanation:

Ŝ              # Get all combinations of positive integers that sum to the (implicit)
                # input-integer
  €             # Map over each inner list:
   œ            #  And get all its permutations
    €`          # Flatten the list of lists of lists one level down
      Ù         # Uniquify the list of lists
       ʒ        # Filter it by:
        Å«      #  Cumulative left-reduce the list by:
          t     #   Taking the square of the current integer
           +    #   And adding it to the previous
         }      #  After the cumulative left-reduce, which keeps all intermediate steps:
          н     #  Pop and push its first item
           §    #  Cast this decimal to a string (bug work-around)
            Ų  #  And check that it's a perfect square
       }g       # After the filter: pop and push the length
                # (which is output implicitly as result)

The § shouldn't have been necessary, but unfortunately there is an 05AB1E bug with decimal values for the Ų builtin.

\$\endgroup\$
5
\$\begingroup\$

Retina, 65 bytes

.+
*_;
+%L$w`^((^_|\2__)*)(;|(?=(_+);(?!\1)))
$#4*$#2*_$4;$#2*_
;

Try it online! Link includes test suite that tests all n up to and including the input. Explanation:

.+
*_;

Convert the input to unary and append a working area for the previous square root.

+`

Repeat until no new solutions can be found.

%`

Check all lines separately for new solutions.

L$w`^((^_|\2__)*)(;|(?=(_+);(?!\1)))

Match all square prefixes of the current value. This ($.1) represents the amount being square rooted on this pass. $#2 is its square root. $.4 is the residue after subtracting the terms so far; $#4 is a flag for whether the residue is non-zero, in which case the square must be greater than the previous square root. This check is not performed if the residue is zero, as the previous residue must have been non-zero anyway, thus allowing completed sequences to remain undisturbed.

$#4*$#2*_$4;$#2*_

For each square prefix, add its square root to the residue, and record the new value along with the square root. However, if the current value turned out to be square, then the square root is skipped and all that remains is the ;. This indicates a completed sequence.

;

Count the number of complete sequences found.

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

APL (Dyalog Unicode), 35 34 bytes

Thanks to Bubbler for -1 byte!

Another port of my Python answer.

0∘{⍵≤⍺:⍵=⍺⋄(⊢+.∇⊢+⍵-×⍨)(⌊⍺*÷2)↓⍳⍵}

Try it online!

The main function is the dfn { ... } which takes \$k\$ as the left argument and \$n+k\$ as the right argument. 0∘ supplies the initial \$k=0\$.

⍵≤⍺:⍵=⍺ is the stopping condition, if \$n+k \le k \Leftrightarrow n \le 0\$, this returns a value of \$1\$ if \$n=0\$ and \$0\$ otherwise.

⍳⍵ is the inclusive range from \$1\$ to \$n+k\$.
⌊⍺*÷2 is the floor of the aqure root of \$k\$.
drops this many items from the range. This results in a new range from \$\left\lceil\sqrt{k}\right\rceil\$ to \$n+k\$. These are the values for \$d\$ that satisfy \$d^2>k\$.

⊢∇¨⊢+⍵-×⍨ is a train applied to this range.
×⍨ squares every value. => \$d^2\$
⍵- subtracts each square from \$n+k\$. => \$n+k-d^2\$
⊢+ adds the range again. This is needed beacuse we actually call the function with \$n+k\$ and not just \$n\$. => \$n+k-d^2 + d\$
is the right argument, in this this case the potential \$d\$'s.
+.∇ is the inner product of the functions + and . First (recurse) is called on every pair of \$d\$ and \$n+k-d^2 + d\$, then the resulting vector is reduced by addition (+).

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

Haskell, 53 bytes

A port of my Python answer.

(#0)
n#k|n==0=1|w<-n+k=sum[(w-d*d)#d|d<-[1..w],d*d>k]

Try it online!

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

Perl 5 (-MList::Utils+sum), 64 bytes

sub f{my($n,$k)=@_;sum!$n,map f($n+$k-$_*$_,$_),$k**.5+1..$n+$k}

Try it online!

Using @ovs formula

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

Jelly (fork), 15 bytes

ŒṗŒ!€ẎQ½+¥/€Æ²S

Try it online!

This will work for some inputs on TIO, but will fail for others due to floating point errors. However, my fork has symbolic math support, meaning that it basically never uses floats.

How it works

This is a brute force attempt. Times out on TIO for \$n \ge 10\$. Uses a similar approach to Kevin's answer, but found independently.

ŒṗŒ!€ẎQ½+¥/€Æ²S - Main link. Takes n on the left
Œṗ              - Integer partitions of n
    €           - Over each:
  Œ!            -   Calculate the permutations
     Ẏ          - Merge into a list of lists
      Q         - Deduplicate
           €    - Over each list:
         ¥/     -   Reduce by:
       ½        -     Square root of left
        +       -     Plus right
            Ʋ  - Is a square?
              S - Sum
\$\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.