A257944 Lexicographically earliest sequence of positive integers such that the terms and their absolute first differences are all distinct and no term is the sum of two distinct terms.
1, 3, 7, 12, 18, 26, 16, 31, 20, 37, 50, 22, 41, 64, 35, 56, 83, 39, 69, 45, 54, 79, 111, 58, 92, 130, 60, 96, 136, 73, 115, 163, 75, 121, 168, 77, 134, 193, 98, 149, 182, 102, 157, 206, 117, 178, 244, 138, 210, 277, 140, 214, 282, 153, 229, 307, 155, 220, 263
Offset: 1
Links
- Alois P. Heinz, Table of n, a(n) for n = 1..10000
- E. Angelini et al., 0-additive and first differences and follow-up messages on the SeqFan list, May 13 2015
Programs
-
Maple
s:= proc() false end: b:= proc() false end: a:= proc(n) option remember; local i, k, ok; if n=1 then b(1):= true; 1 else for k do if b(k) or s(k) or (t-> b(t) or t=k)( abs(a(n-1)-k)) then next fi; ok:=true; for i to n-1 while ok do if b(k+a(i)) then ok:=false fi od; if ok then break fi od; for i to n-1 do s(a(i)+k):= true od; b(k), b(abs(a(n-1)-k)):= true$2; k fi end: seq(a(n), n=1..101);
-
Mathematica
s[] = False; b[] = False; a[n_] := a[n] = Module[{i, k, ok}, If[n == 1, b[1] = True; 1, For[k = 1, True, k++, If[b[k] || s[k] || Function[t, b[t] || t == k][Abs[a[n-1] - k]], Continue[]]; ok = True; For[i = 1, i <= n-1 && ok, i++, If[b[k + a[i]], ok = False]]; If[ok, Break[]]]; For[i = 1, i <= n-1, i++, s[a[i] + k] = True]; {b[k], b[Abs[a[n-1] - k]]} = {True, True}; k]]; Table[a[n], {n, 1, 101}] (* Jean-François Alcover, Jul 16 2021, after Alois P. Heinz *)
Comments