Numbers which are not the sum of distinct squares: Difference between revisions

From Rosetta Code
Content added Content deleted
(added =={{header|Pascal}}==)
m (→‎{{header|Free Pascal}}: OK,"Do not use magic numbers or pre-determined limits" therefore FindLongestContiniuosBlock)
Line 65: Line 65:
SumOfSquare-2, SumOfSquare-3,SumOfSquare-6,...SumOfSquare-108,SumOfSquare-112,SumOfSquare-128<br>
SumOfSquare-2, SumOfSquare-3,SumOfSquare-6,...SumOfSquare-108,SumOfSquare-112,SumOfSquare-128<br>
<lang pascal>program practicalnumbers;
<lang pascal>program practicalnumbers;
{$IFDEF Windows}
{$IFDEF Windows} {$APPTYPE CONSOLE} {$ENDIF}
{$APPTYPE CONSOLE}
{$ENDIF}
var
var
HasSum: array of byte;
HasSum: array of byte;
function FindLongestContiniuosBlock(startIdx,MaxIdx:NativeInt):NativeInt;
var
hs0 : pByte;
l : NativeInt;
begin
l := 0;
hs0 := @HasSum[0];
for startIdx := startIdx to MaxIdx do
Begin
IF hs0[startIdx]=0 then
BREAK;
inc(l);
end;
FindLongestContiniuosBlock := l;
end;


function SumAllSquares(Limit: Uint32):NativeInt;
function SumAllSquares(Limit: Uint32):NativeInt;
Line 75: Line 88:
var
var
hs0, hs1: pByte;
hs0, hs1: pByte;
idx, j, maxlimit, delta,len1TopDown: NativeInt;
idx, j, maxlimit, delta,MaxContiniuos,MaxConOffset: NativeInt;
begin
begin
len1TopDown :=0;
MaxContiniuos := 0;
MaxConOffset := 0;
maxlimit := 0;
maxlimit := 0;
hs0 := @HasSum[0];
hs0 := @HasSum[0];
hs0[0] := 1; //has sum of 0*0
hs0[0] := 1; //has sum of 0*0
writeln('number longest block sum of');
writeln(' starting at 129 squares');
idx := 1;
idx := 1;

writeln('number offset longest sum of');
writeln(' block squares');
while idx <= Limit do
while idx <= Limit do
begin
begin
delta := idx*idx;
delta := idx*idx;
//delta is within the continiuos range than break
If len1TopDown-129 > delta then
If (MaxContiniuos-MaxConOffset) > delta then
Break;
BREAK;

//mark oldsum+ delta with oldsum
//mark oldsum+ delta with oldsum
hs1 := @hs0[delta];
hs1 := @hs0[delta];
for j := maxlimit downto 0 do
for j := maxlimit downto 0 do
hs1[j] := hs1[j] or hs0[j];
hs1[j] := hs1[j] or hs0[j];

maxlimit := maxlimit + delta;
maxlimit := maxlimit + delta;

//search for a block of only '1' in this block all numbers are possible sum of squarenumbers
len1TopDown :=0;
j := MaxConOffset;
repeat
for j := 129 to maxlimit do
delta := FindLongestContiniuosBlock(j,maxlimit);
Begin
IF hs0[j]=0 then
IF delta>MaxContiniuos then
BREAK;
begin
inc(len1TopDown);
MaxContiniuos:= delta;
MaxConOffset := j;
end;
end;
writeln(idx:3,len1TopDown:14,maxlimit:14);
inc(j,delta+1);
until j > (maxlimit-delta);
writeln(idx:4,MaxConOffset:7,MaxContiniuos:8,maxlimit:8);
inc(idx);
inc(idx);
end;
end;
Line 113: Line 134:
n: NativeInt;
n: NativeInt;
begin
begin
Limit := 100;
Limit := 25;
sumsquare := 0;
sumsquare := 0;
for n := 1 to Limit do
for n := 1 to Limit do
sumsquare := sumsquare+n*n;
sumsquare := sumsquare+n*n;
writeln('sum of square [1..',limit,'] = ',sumsquare) ;
writeln('sum of square [1..',limit,'] = ',sumsquare) ;
writeln;
setlength(HasSum,sumsquare+1);
setlength(HasSum,sumsquare+1);
n := SumAllSquares(Limit);
n := SumAllSquares(Limit);
Line 126: Line 149:
setlength(HasSum,0);
setlength(HasSum,0);
{$IFNDEF UNIX} readln; {$ENDIF}
{$IFNDEF UNIX} readln; {$ENDIF}
end.</lang>
end.
</lang>
{{out}}
{{out}}
<pre>
<pre>
sum of square [1..100] = 338350
sum of square [1..25] = 5525

number longest block sum of
number offset longest sum of
starting at 129 squares
1 0 1
block squares
2 0 5
1 0 2 1 -> 0,1
3 0 14
2 0 2 5
4 0 30
3 0 2 14
5 0 55
4 0 2 30
6 0 91
5 0 2 55
7 0 140
6 34 9 91 ->34..42
8 3 204
7 49 11 140 ->49..59
9 28 285
8 77 15 204 ->77..91
10 128 +2*128+1= 385
9 129 28 285
11 249 +257 = 506
10 129 128 385
12 393 +257 = 650
11 129 249 506
12 129 393 650
13
13
2,3,6,7,8,11,12,15,18,19,22,23,24,27,28,31,32,33,43,44,47,48,60,67,72,76,92,96,108,112,128,
2,3,6,7,8,11,12,15,18,19,22,23,24,27,28,31,32,33,43,44,47,48,60,67,72,76,92,96,108,112,128,
</pre>
</pre>

=={{header|Phix}}==
=={{header|Phix}}==
As per Raku (but this is using a simple flag array), if we find a block of n<sup><small>2</small></sup> summables,
As per Raku (but this is using a simple flag array), if we find a block of n<sup><small>2</small></sup> summables,

Revision as of 14:07, 25 November 2021

Numbers which are not the sum of distinct squares is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.


Integer squares are the set of integers multiplied by themselves: 1 x 1 = 1, 2 × 2 = 4, 3 × 3 = 9, etc. ( 1, 4, 9, 16 ... )

Most positive integers can be generated as the sum of 1 or more distinct integer squares.

     1 == 1
     5 == 4 + 1
    25 == 16 + 9
    77 == 36 + 25 + 16
   103 == 49 + 25 + 16 + 9 + 4

Many can be generated in multiple ways:

    90 == 36 + 25 + 16 + 9 + 4 == 64 + 16 + 9 + 1 == 49 + 25 + 16 == 64 + 25 + 1 == 81 + 9
   130 == 64 + 36 + 16 + 9 + 4 + 1 == 49 + 36 + 25 + 16 + 4 == 100 + 16 + 9 + 4 + 1 == 81 + 36 + 9 + 4 == 64 + 49 + 16 + 1 == 100 + 25 + 4 + 1 == 81 + 49 == 121 + 9    

A finite number can not be generated by any combination of distinct squares:

   2, 3, 6, 7, etc.


Task

Find and show here, on this page, every positive integer than can not be generated as the sum of distinct squares.

Do not use magic numbers or pre-determined limits. Justify your answer mathematically.


See also

Julia

A true proof of the sketch below would require formal mathematical induction. <lang julia>#= Here we show all the 128 < numbers < 400 can be expressed as a sum of distinct squares. Now 11 * 11 < 128 < 12 * 12. It is also true that we need no square less than 144 (12 * 12) to reduce via subtraction of squares all the numbers above 400 to a number > 128 and < 400 by subtracting discrete squares of numbers over 12, since the interval between such squares can be well below 128: for example, |14^2 - 15^2| is 29. So, we can always find a serial subtraction of discrete integer squares from any number > 400 that targets the interval between 129 and 400. Once we get to that interval, we already have shown in the program below that we can use the remaining squares under 400 to complete the remaining sum. =#

using Combinatorics

squares = [n * n for n in 1:20]

possibles = [n for n in 1:500 if all(combo -> sum(combo) != n, combinations(squares))]

println(possibles)

</lang>

Output:
[2, 3, 6, 7, 8, 11, 12, 15, 18, 19, 22, 23, 24, 27, 28, 31, 32, 33, 43, 44, 47, 48, 60, 67, 72, 76, 92, 96, 108, 112, 128]

Pascal

Free Pascal

Modified Practical_numbers#Pascal.
Searching for a block of numbers that are all a possible sum of square numbers.
There is a symmetry of hasSum whether
2,3,6,..108,112,128,
are not reachably nor
SumOfSquare-2, SumOfSquare-3,SumOfSquare-6,...SumOfSquare-108,SumOfSquare-112,SumOfSquare-128
<lang pascal>program practicalnumbers; {$IFDEF Windows} {$APPTYPE CONSOLE} {$ENDIF} var

 HasSum: array of byte;

function FindLongestContiniuosBlock(startIdx,MaxIdx:NativeInt):NativeInt; var

 hs0 : pByte;
 l : NativeInt;

begin

 l := 0;
 hs0 := @HasSum[0];
 for startIdx := startIdx to MaxIdx do
 Begin
   IF hs0[startIdx]=0 then
     BREAK;
   inc(l);
 end;
 FindLongestContiniuosBlock := l;

end;

function SumAllSquares(Limit: Uint32):NativeInt; //mark sum and than shift by next summand == add var

 hs0, hs1: pByte;
 idx, j, maxlimit, delta,MaxContiniuos,MaxConOffset: NativeInt;

begin

 MaxContiniuos := 0;
 MaxConOffset := 0;
 maxlimit := 0;
 hs0 := @HasSum[0];
 hs0[0] := 1; //has sum of 0*0
 idx := 1;
 writeln('number offset  longest  sum of');
 writeln('                block  squares');
 while idx <= Limit do
 begin
   delta := idx*idx;
   //delta is within the continiuos range than break
   If (MaxContiniuos-MaxConOffset) > delta then
     BREAK;
   //mark oldsum+ delta with  oldsum
   hs1 := @hs0[delta];
   for j := maxlimit downto 0 do
     hs1[j] := hs1[j] or hs0[j];
   maxlimit := maxlimit + delta;
   j := MaxConOffset;
   repeat
     delta := FindLongestContiniuosBlock(j,maxlimit);
     IF delta>MaxContiniuos then
     begin
       MaxContiniuos:= delta;
       MaxConOffset := j;
     end;
     inc(j,delta+1);
   until j > (maxlimit-delta);
   writeln(idx:4,MaxConOffset:7,MaxContiniuos:8,maxlimit:8);
   inc(idx);
 end;
 SumAllSquares:= idx;

end;

var

 limit,
 sumsquare,
 n: NativeInt;

begin

 Limit := 25;
 sumsquare := 0;
 for n := 1 to Limit do
   sumsquare := sumsquare+n*n;
 writeln('sum of square [1..',limit,'] = ',sumsquare) ;
 writeln;
 
 setlength(HasSum,sumsquare+1);
 n := SumAllSquares(Limit);
 writeln(n);
 for Limit := 1 to n*n do
   if HasSum[Limit]=0 then
     write(Limit,',');
 setlength(HasSum,0);
{$IFNDEF UNIX}  readln; {$ENDIF}

end. </lang>

Output:
sum of square [1..25] = 5525

number offset  longest  sum of
                block  squares
   1      0       2       1   -> 0,1
   2      0       2       5
   3      0       2      14
   4      0       2      30
   5      0       2      55
   6     34       9      91  ->34..42
   7     49      11     140  ->49..59
   8     77      15     204  ->77..91
   9    129      28     285  
  10    129     128     385
  11    129     249     506
  12    129     393     650
13
2,3,6,7,8,11,12,15,18,19,22,23,24,27,28,31,32,33,43,44,47,48,60,67,72,76,92,96,108,112,128,

Phix

As per Raku (but this is using a simple flag array), if we find a block of n2 summables, that is guaranteed to become at least twice that length in the next step, and it will (eventually) overwrite any subsequent holes, since it is longer than and overlaps the 2*n+1 gap between squares, at least that's my thinking...

Actually, a 2*n+1 (or maybe 2*n+3) block should be enough, and that works fine too. You can run this online here.

with javascript_semantics
sequence summable = {true} -- (1 can be expressed as 1*1)
integer n = 2
while true do
    integer sq = n*n
    summable &= repeat(false,sq)
    -- (process backwards to avoid adding sq more than once)
    for i=length(summable)-sq to 1 by -1 do
        if summable[i] then
            summable[i+sq] = true
        end if
    end for
    summable[sq] = true
    integer r = match(repeat(true,(n+1)*(n+1)),summable)
--  -- (next works too, but I'm not sure that's "proof")
--  integer r = match(repeat(true,sq),summable)
    if r then
        summable = summable[1..r-1]
        exit
    end if
    n += 1
end while
constant nwansods = "numbers which are not the sum of distinct squares"
printf(1,"%s\n",{join(shorten(apply(find_all(false,summable),sprint),nwansods,5))})
Output:
2 3 6 7 8 ... 92 96 108 112 128  (31 numbers which are not the sum of distinct squares)

Raku

Try it online!

Spoiler: (highlight to read)
Once the longest run of consecutive generated sums is longer the the next square, every number after can be generated by adding the next square to every number in the run. Find the new longest run, add the next square, etc. <lang perl6>my @squares = ^∞ .map: *²; # Infinite series of squares

for 1..∞ -> $sq { # for every combination of all squares

   my @sums = @squares[^$sq].combinations».sum.unique.sort;
   my @run;
   for @sums {
       @run.push($_) and next unless @run.elems;
       if $_ == @run.tail + 1 { @run.push: $_ } else { last if @run.elems > @squares[$sq]; @run = () }
   }
   put grep * ∉ @sums, 1..@run.tail and last if @run.elems > @squares[$sq];

}</lang>

Output:
2 3 6 7 8 11 12 15 18 19 22 23 24 27 28 31 32 33 43 44 47 48 60 67 72 76 92 96 108 112 128

Wren

Well I found a proof by induction here that there are only a finite number of numbers satisfying this task but I don't see how we can prove it programatically without using a specialist language such as Agda or Coq.

So I've therefore used a brute force approach to generate the relevant numbers, similar to Julia, except using the same figures as the above proof. Still slow in Wren, around 20 seconds. <lang ecmascript>var squares = (1..18).map { |i| i * i }.toList var combs = [] var results = []

// generate combinations of the numbers 0 to n-1 taken m at a time var combGen = Fn.new { |n, m|

   var s = List.filled(m, 0)
   var last = m - 1
   var rc // recursive closure
   rc = Fn.new { |i, next|
       var j = next
       while (j < n) {
           s[i] = j
           if (i == last) {
               combs.add(s.toList)
           } else {
               rc.call(i+1, j+1)
           }
           j = j + 1
       }
   }
   rc.call(0, 0)

}

for (n in 1..324) {

   var all = true
   for (m in 1..18) {
       combGen.call(18, m)
       for (comb in combs) {
           var tot = (0...m).reduce(0) { |acc, i| acc + squares[comb[i]] }
           if (tot == n) {
               all = false
               break
           }
       }
       if (!all) break
       combs.clear()
   }
   if (all) results.add(n)

}

System.print("Numbers which are not the sum of distinct squares:") System.print(results)</lang>

Output:
Numbers which are not the sum of distinct squares:
[2, 3, 6, 7, 8, 11, 12, 15, 18, 19, 22, 23, 24, 27, 28, 31, 32, 33, 43, 44, 47, 48, 60, 67, 72, 76, 92, 96, 108, 112, 128]