23
\$\begingroup\$

Task

Write a program/function that when given a positive integer \$n\$ splits the numbers from \$1\$ to \$n\$ into two sets, so that no integers \$a, b, c\$, satisfying \$a^2 + b^2 = c^2\$ are all in the same set. For example, if \$3\$ and \$4\$ are in the first set, then \$5\$ must be in the second set since \$3^2+4^2=5^2\$.

Acceptable Output Formats:

  • One of the sets
  • Both the sets
  • An array of length \$n\$ where the \$i\$-th element (counting from 1) is one of two different symbols (e.g. 0 and 1, a and b, etc.) which represent which set \$i\$ belongs to.The reverse of this is also fine

Constraints

You can expect \$n\$ to be less than \$7825\$. This is because \$7824\$ is proven to be the largest number to have solution (which also implies that all numbers less than 7825 have a solution).

Scoring

This is so shortest bytes wins.

Sample Testcases

3 -> {1}
3 -> {}
5 -> {1, 2, 3}
5 -> {1, 2, 3}, {4, 5}
5 -> [0, 0, 0, 1, 1]
5 -> [1, 1, 0, 0, 1]
10 -> {1, 3, 6}
10 -> {1, 2, 3, 4, 6, 9}
41 -> {5, 6, 9, 15, 16, 20, 24, 35}

A checker to verify your output can be found here

Inspired by The Problem with 7825 - Numberphile

Improve this question
\$\endgroup\$
9
  • 1
    \$\begingroup\$ Is it guaranteed that a solution exists for all n below 7825? It may be worth clarifying in the challenge \$\endgroup\$
    – Luis Mendo
    Jun 20, 2020 at 16:04
  • \$\begingroup\$ Suggested test case: 41. This is the first value for which this simple but invalid algorithm doesn't work anymore: start with an empty list A; for x = 1 to n: if there's some x in A such that sqrt(x²+n²) also exists in A: leave A unchanged else append x to A; return A. \$\endgroup\$
    – Arnauld
    Jun 20, 2020 at 16:08
  • 1
    \$\begingroup\$ @LuisMendo Theorem 1. The set {1, . . . , 7824} can be partitioned into two parts, such that no part contains a Pythagorean triple, while this is impossible for {1, . . . , 7825}. arxiv.org/pdf/1605.00723.pdf \$\endgroup\$
    – ZaMoC
    Jun 20, 2020 at 16:33
  • \$\begingroup\$ @Arnauld added 41 as a testcase \$\endgroup\$
    – Mukundan314
    Jun 20, 2020 at 16:52
  • \$\begingroup\$ May we output an empty set when \$n<5\$? (I would assume so.) \$\endgroup\$
    – Jonathan Allan
    Jun 20, 2020 at 19:25

9 Answers 9

Reset to default
7
\$\begingroup\$

J, 37 bytes

Brute forces through the possible sets, outputs the bit mask.

((-&.#.+./@,)[(e.~+/~)/.*:@#\)^:_@#&1

Try it online! (Also outputs list as numbers for easier comparison.)

How it works

((-&.#.+./@,)[(e.~+/~)/.*:@#\)^:_@#&1
                                  #&1 convert to list of N 1's
(                            )^:_     do until list does not change
                        *:@#\         right: convert to 1,4,9…,N^2
             [                        left: the bit mask
                      /.              partition left based on right, for each set:
                  +/~                 make M*M addition table
               e.~                    any element of that in the same set?
       +./@,                          OR all answers: 1 on conflict, 0 if finished
  -&.#.                               list: from base 2, subtract that^, to base 2
Improve this answer
\$\endgroup\$
2
  • \$\begingroup\$ I guess 1,2,4…,N^2 is a typo of 1,4,9…,N^2? \$\endgroup\$
    – Bubbler
    Jun 21, 2020 at 23:27
  • \$\begingroup\$ @Bubbler Indeed! \$\endgroup\$
    – xash
    Jun 21, 2020 at 23:39
6
\$\begingroup\$

Wolfram Language (Mathematica), 132 116 bytes

{1}.SatisfiabilityInstances[And@@(And[Or@@#,Nand@@#]&/@Map[x,Select[#~Tuples~3,{1,1,-1}.#^2==0&],{2}]),x/@#]&@*Range

Try it online!

This uses Mathematica's SAT solver to label the integers 1 through the input as True and False.

  • This is composed with Range, so what feeds into the main function is a list of the integers from 1 to the input.
  • Select[#~Tuples~3,{1,1,-1}.#^2==0&] generates all the Pythagorean triples (multiple times actually, but that's okay).
  • And[Or@@#,Nand@@#]& is true if at least one, but not all, of the elements of its input is true.
  • {1}.SatisfiabilityInstances[...,x/@#] uses the SAT solver. Since SatisfiabilityInstances returns a list containing one solution, we use {1}. to get its first element.
Improve this answer
\$\endgroup\$
4
  • \$\begingroup\$ Very nice +1! you can use infix notation in ~Subsets~ to save a byte. Also your program must be a function and that costs 3 bytes... Try it online! \$\endgroup\$
    – ZaMoC
    Jun 20, 2020 at 21:35
  • \$\begingroup\$ @J42161217 My program is a function, I just haven't finished it with &: it's the composition of two functions, {1}.Satisf....,x/@#]& and Range. Your version composes with Range@#& instead which is equivalent to Range, but longer. \$\endgroup\$
    – Misha Lavrov
    Jun 20, 2020 at 21:40
  • \$\begingroup\$ My bad, here is a better presentation 131 bytes! \$\endgroup\$
    – ZaMoC
    Jun 20, 2020 at 21:57
  • \$\begingroup\$ I ended up going with Tuples instead, because #~Tuples~3 is shorter than #~Subsets~{3}. It also generates way more triples, and even after the Select we end up getting {3,4,5} and {4,3,5} separately, but that's fine. \$\endgroup\$
    – Misha Lavrov
    Jun 20, 2020 at 22:07
6
\$\begingroup\$

Jelly, 18 bytes

œc3²SHeƊ$Ƈ
ÇŒpÇÞḢQ

Try it online! (too inefficient for \$n>25\$ on TIO).

How?

Strategy: Find all Pythagorean triples using \$[1,n]\$ then find a way to pick 1 element from each of them such that the resulting set contains no Pythagorean triples. That way we have a set which both contains no Pythagorean triple and blocks the other set from having any.

œc3²SHeƊ$Ƈ - Link 1, find all Pythagorean triples: list of integers OR number
œc3        - all combination of length 3 (given n uses [1..n])
         Ƈ - keep those for which:
        $  -   last two links as a monad:
   ²       -     square each of them
       Ɗ   -     last three links as a monad:
    S      -       sum (of the three squares)
     H     -       halved
      e    -       exists in (the squares)?

ÇŒpÇÞḢQ - Main Link: n
Ç       - call Link 1 as a monad -> all Pythagorean triples using [1,n]
 Œp     - Cartesian product -> all ways to pick one from each
    Þ   - sort those by:
   Ç    -   call Link 1 as a monad (empty lists are less than non-empty ones)
     Ḣ  - head
      Q - deduplicate (if n < 7825 this is a valid answer)
Improve this answer
\$\endgroup\$
11
  • 1
    \$\begingroup\$ Nice! Certainly runs faster than mine, besides being much shorter \$\endgroup\$
    – fireflame241
    Jun 20, 2020 at 19:30
  • \$\begingroup\$ What is the purpose of ÇÞ? Isn't the Cartesian product automatically in that order? \$\endgroup\$
    – fireflame241
    Jun 20, 2020 at 19:40
  • 2
    \$\begingroup\$ No, once \$n=26\$ the result's first item will contain \$6\$, \$8\$, and \$10\$. (So taking the smallest of each triple is not a valid strategy.) \$\endgroup\$
    – Jonathan Allan
    Jun 20, 2020 at 19:45
  • \$\begingroup\$ Oh, I misunderstood how Þ works, and I was about to bring up the counterexample for n=86 ((5,12,13),(12,35,37),(13,84,85)) \$\endgroup\$
    – fireflame241
    Jun 20, 2020 at 19:47
  • 1
    \$\begingroup\$ In that case, I retract my objection - assuming that, as you pick more than one due to repeats, you check that you don't end up picking all of a triple eventually. If you have a valid partition into two sets X and Y, you can just, for each triple, pick an element of that triple that's in X. The set Z of all elements picked is a subset of X (so it doesn't contain all of any triple) but contains one element of each triple by construction. \$\endgroup\$
    – Misha Lavrov
    Jun 21, 2020 at 20:13
5
\$\begingroup\$

JavaScript (ES6),  118  117 bytes

Much slower for -1 byte.

f=(n,a=[],b=a)=>n?f(n-1,[n,...a],b)||f(n-1,a,[n,...b]):[a,b][E='every'](o=>o[E](x=>o[E](y=>o[E](k=>k*k-x*x+y*y))))&&b

Try it online!

JavaScript (ES6),  122 119  118 bytes

Returns one of the sets as an array.

f=(n,a=[],b=a)=>[a,b][S='some'](o=>o[S](x=>o[S](y=>o[S](k=>k*k==x*x+y*y))))?0:n?f(n-1,[n,...a],b)||f(n-1,a,[n,...b]):b

Try it online!

Solution found locally for \$n=41\$:

[ 5, 6, 9, 15, 16, 20, 24, 35 ]
Improve this answer
\$\endgroup\$
4
\$\begingroup\$

05AB1E, 14 bytes

Port of the 17 byte Jelly answer. (Læ3ùʒDnO;tå}€н is the same length)

Læ3ùʒnRćsOQ}€н

Try it online!

Explanation

L              Length range
 æ             Powerset
  3ù           Pick truples (length-3 tuples)
    ʒ          Filter:
     n             Square all items
      R            Reverse the list
       ć           Head-extract (head on top)
        s          Swap
         O         Sum the remaining list
          Q}       Equal?
            €н Take head of each
Improve this answer
\$\endgroup\$
1
  • \$\begingroup\$ Not sure how to fix it, but it's currently incorrect for certain inputs \$\geq26\$, just like Jonathan's initial answer. PS: using 3.Æ is faster than æ3ù, although it doesn't matter for the byte-count. :) \$\endgroup\$
    – Kevin Cruijssen
    Jun 22, 2020 at 7:21
3
\$\begingroup\$

Jelly, 30 26 bytes

œ|/L=³
Œc§œ&
ŒP²ÇẸƊÐḟŒcÑƇḢ

Try it online!

How?

This does a more brute-force approach, filtering subsets of [1..n] based on whether they contain any Pythagorean triples. Then, it finds two triple-less subsets that have all n elements between them

œ|/L=³         # Test if a pair of sets unions to [1..n]
œ|/              # Set intersection  
   L             # Is the length
    =³           # equal to n?       

Œc§œ&          # Does a pair exist that sums to another?
Œc               # Compute all pairs of squares
  §              # Sum each
   œ&            # Set intersection with the set of squares (nonempty & truthy if a pair of squares sum to another square)

ŒP²ÇẸƊÐḟŒcÑƇḢ  # Main link
ŒP               # All subsets of 1..n
     ƊÐḟ         # Remove those where:
  ²                # of the squares,
   ÇẸ              # a pair of the squares exists that sum to another square
        Œc       # All pairs of these triple-less subsets
          ÑƇ     # Filter the pairs by whether they union to [1..n]
            Ḣ    # Head; get the first one
Improve this answer
\$\endgroup\$
2
\$\begingroup\$

Wolfram Language (Mathematica), 1664 bytes

works for all n (1 to 7824) instantly

IntegerDigits[Uncompress@"1:eJwllsmRHDkMRXWVGfIAKwGYoKtMGAfG/5veT0V0dHVlkiDwN/av//7/87t+/vjhPfem6tm+K6+yqFft5e/e9fXzeH6W62050307NdsTzYtIe/mMApOd/mJY5G/Yn9FdxidPe95uu/lGRNu2+U2n1c6zypfbWza7m80S99pKerF625V9oeNuzW1ywnt92jfZUcXbV94eHrael5Evyo1vHazcy3LPpOa7fXNlmW6d0xF0QXvLBHP+ikf2mKuDBp+1v94BBtvQlEDVdrdRfES8pIPsR1mmfAOUUXdeN2f8DvZzxNFc64c5VWJjPGie0rHls/TaOo4TmoGXtwx4Ry/rHzwDEtbwMwYbMDW2xhkvg18BoPva04zBJqAwisL+AbcLa34OLdSBUGpa1VlDJp3G2wqtA+zTgmz4sTh7YxCVN1RCFYy7x3z5ivIghVhm/s3vBxM6F1S0KJO5k8GpRiuMbRCaRT1eF1NoRSGflb7OUYgJJSYNOoRzyIDMLEaCQgAxNFWsRkq5zPxGDYZLewakSRvgCRNrcJ92EFzis1FSIhnoZ8pYZ3HeA4TJfUwq+RiyB478gA7UA7QgUxl05yvcKDHgOonYOcLfciywwgKLC+ICNSWqFNaLYFEzQ6ANmsEBJ96ZhnEwE5prPX06RBYD20FJPVk6EyrYfOoK3dnniG+kCBBbCY1Ra/FGBfDtMzB/vEItgKMRAYiHqDREkghhA5KiC6jFTp8nGAycUCi+dg6B4ZdSGxMVXb8bGWLYOgQDzFe0fG3wztNPk/edjBV6v5m1uOgvMKCxOwBWtr5OoAYuFmUyTAkdkiNoytgrx32iBDDEjzsfsdQJltIFFnaAQztkUigpUtSiG+Y98Jz56Ejgv0eXhBAiwhtKBVYjqpJdqB8KHPQN60QCRj+gnFWejUKLrUQAuHIcwmUh/sQAYIqxlBAGcHCF2S+pCdPsY/hHMAZKEVBCn9AUeyB0wEcZZClbIEmXLkyZ5YMM5dSobQkJQbjyQoYAE4J05LbAcwpAlJQu8VIKW4M4PsccBJFi4TxOPiyRKUJMcc7LIO1JVgWiwpHoIWA4oTj0Ri2yAqsiQZS6Cm9QIXpLtwCGIU0lb3TzkcyM0iEvsA5mHPLi5OPH/SBx4zj6IeMfwxnC/HQ68ouCiGBS42nw6ErC/eIaJYEQoHIWgIFRSo7QA2ZomqcKfSEKyDdKcsUXPXAlYNf40HqfbCBMzgKVc5pFvs6nxodtJ9xV9+kOITFIVFAfdYMAWrfQY03joC+08pt2kZgpz584m4EWhA4x/I0WHNjo7xBP4ifFGfgf3VIIueRHe0jyaL+rkQhEk6xGhpXi8LlBu4YBYYyAnaAHw1MeBRUXMLoAfK5S3IfisZWE+7jYKN4EGG2SlkBlKICHzEOaLxFKWuMImiBA0bLMAi3IBR/wUNnByvhCD1uTcsJLN04oGBu9SaKGlJFAKs24krEs9NKZ7h0oxTkMTAYUyjn91xAKWMCFv8CZyock+EGWMjCutNANrdZOqY0Z0T66Yr2oJswJ+FBaKHORK8sOAbUuruSWkR5gRbZoLuYPer7CORkDULwUjQgHD++RLKBOR0p3EkvGh0VG4pbCOyt+QBs99V9DtuSl",2][[;;#]]&

Try it online!

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

R, 99 95 bytes

n=scan():1
f=function(j)outer(a<-n[j]^2,a,`+`)%in%a
while(any(f(i<-sample(!0:1,n,T)),f(!i)))0 
i

Try it online!

Outputs a vector of TRUE and FALSE representing in reverse order which set each integer belongs to. (The footer of the TIO transforms this into a list of integers in the first set.)

Works by random sampling: repeatedly draw a random subset of 1:n until neither the subset nor its complement contain any Pythagorean triples (checked by the function f).

It will finish in finite time for any input <7825, but will in expectation take a very long time for largeish n. TIO starts timing out around n=90.

Improve this answer
\$\endgroup\$
1
\$\begingroup\$

Charcoal, 74 bytes

ＮθＦθＦιＦκＦ⁼Ｘ⊕ι²ΣＸ⊕⟦κλ⟧²⊞υ⊕⟦ικλ⟧≔⁰ηＷ¬ⅉ«≔Ｅυ§κ÷ηＸ³λζ≦⊕η≔Ｘζ²ε¿¬⊙ε⊙ε№ε⁺κμＩ⁻Ｅθ⊕κζ

Try it online! Well, for n<50, otherwise it gets too slow. Link is to verbose version of code. Based on @JonathanAllen's answer. Explanation:

Ｎθ

Input n.

ＦθＦιＦκ

Loop through all potential Pythagorean triples.

Ｆ⁼Ｘ⊕ι²ΣＸ⊕⟦κλ⟧²

If this is indeed a triple,

⊞υ⊕⟦ικλ⟧

then push it to the empty list.

≔⁰η

Start iterating through the ways of picking one element of each triple.

Ｗ¬ⅉ«

Repeat until output has been generated.

≔Ｅυ§κ÷ηＸ³λζ

Pick one element from each triple.

≦⊕η

Increment the loop counter.

≔Ｘζ²ε

Square the elements.

¿¬⊙ε⊙ε№ε⁺κμ

Check for Pythagorean triples.

Ｉ⁻Ｅθ⊕κζ

If none, then output one of the sets.

Improve this answer
\$\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.