Rare numbers
- Definitions and restrictions
Rare numbers are positive integers n where:
- n is expressed in base ten
- r is the reverse of n (decimal digits)
- n must be non-palindromic (n ≠ r)
- (n+r) is the sum
- (n-r) is the difference and must be positive
- the sum and the difference must be perfect squares
- Task
-
- find and show the first 5 rare numbers
- find and show the first 8 rare numbers (optional)
- find and show more rare numbers (stretch goal)
Show all output here, on this page.
- References
-
- an OEIS entry: A035519 rare numbers.
- an OEIS entry: A059755 odd rare numbers.
- planetmath entry: rare numbers. (some hints)
- author's website: rare numbers by Shyam Sunder Gupta. (lots of hints and some observations).
F#
The Function
This solution demonstrates the concept described in Talk:Rare_numbers#30_mins_not_30_years. It doesn't use Cartesian_product_of_two_or_more_lists#Extra_Credit <lang fsharp> // Find all Rare numbers with a digits. Nigel Galloway: September 18th., 2019. let rareNums a=
let tN=set[1L;4L;5L;6L;9L] let izPS g=let n=(float>>sqrt>>int64)g in n*n=g let n=[for n in [0..a/2-1] do yield ((pown 10L (a-n-1))-(pown 10L n))]|>List.rev let rec fN i g e=seq{match e with 0->yield g |e->for n in i do yield! fN [-9L..9L] (n::g) (e-1)}|>Seq.filter(fun g->let g=Seq.map2(*) n g|>Seq.sum in g>0L && izPS g) let rec fG n i g e l=seq{ match l with h::t->for l in max 0L (0L-h)..min 9L (9L-h) do if e>1L||l=0L||tN.Contains((2L*l+h)%10L) then yield! fG (n+l*e+(l+h)*g) (i+l*g+(l+h)*e) (g/10L) (e*10L) t |_->if n>(pown 10L (a-1)) then for l in (if a%2=0 then [0L] else [0L..9L]) do let g=l*(pown 10L (a/2)) in if izPS (n+i+2L*g) then yield (i+g,n+g)} fN [0L..9L] [] (a/2) |> Seq.collect(List.rev >> fG 0L 0L (pown 10L (a-1)) 1L)
</lang>
43 down
<lang fsharp> let test n=
let t = System.Diagnostics.Stopwatch.StartNew() for n in (rareNums n) do printfn "%A" n t.Stop() printfn "Elapsed Time: %d ms for length %d" t.ElapsedMilliseconds n
[2..17] |> Seq.iter test </lang>
- Output:
(56L, 65L) Elapsed Time: 31 ms for length 2 Elapsed Time: 0 ms for length 3 Elapsed Time: 0 ms for length 4 Elapsed Time: 0 ms for length 5 (77126L, 621770L) Elapsed Time: 6 ms for length 6 Elapsed Time: 6 ms for length 7 Elapsed Time: 113 ms for length 8 (280980182L, 281089082L) Elapsed Time: 72 ms for length 9 (2022562202L, 2022652202L) (2002382402L, 2042832002L) Elapsed Time: 1525 ms for length 10 Elapsed Time: 1351 ms for length 11 (871479645278L, 872546974178L) (871457865278L, 872568754178L) (757480195868L, 868591084757L) Elapsed Time: 27990 ms for length 12 (5881592039796L, 6979302951885L) Elapsed Time: 26051 ms for length 13 (20240939631302L, 20313693904202L) (20240793831302L, 20313839704202L) (20222975613302L, 20331657922202L) (20222757813302L, 20331875722202L) (20220757833302L, 20333875702202L) (240739831304L, 40313893704200L) (202739815304L, 40351893720200L) Elapsed Time: 552922 ms for length 14 (200137583241002L, 200142385731002L) (221457543264122L, 221462345754122L) (816921665489618L, 816984566129618L) (244670699815542L, 245518996076442L) (200660494832402L, 204238494066002L) (244781494953842L, 248359494187442L) (240422198260442L, 244062891224042L) (5434293850304L, 403058392434500L) (43430495450144L, 441054594034340L) Elapsed Time: 512282 ms for length 15 (2126675496873312L, 2133786945766212L) (2124893498655312L, 2135568943984212L) (8180266864511918L, 8191154686620818L) (8180264686511918L, 8191156864620818L) (2124697854675312L, 2135764587964212L) (2124675676875312L, 2135786765764212L) (8180044686731918L, 8191376864400818L) (2021612621138702L, 2078311262161202L) (7152956206592508L, 8052956026592517L) (7152956026592508L, 8052956206592517L) (7541459867230568L, 8650327689541457L) (7541437689430568L, 8650349867341457L) (5046466897757516L, 6157577986646405L) (124675496875314L, 4135786945764210L) (143818075679886L, 6889765708183410L) Elapsed Time: 11568713 ms for length 16 (86965749405756968L, 86965750494756968L) (22541929604024522L, 22542040692914522L) (4656716501952776L, 67725910561765640L) Elapsed Time: 11275839 ms for length 17
Go
This uses many of the hints within Shyam Sunder Gupta's webpage combined with Nigel Galloway's general approach (see Talk page) of working from (n-r) and deducing the Rare numbers with various numbers of digits from there.
As the algorithm used does not generate the Rare numbers in order, a sorted list is also printed. <lang go>package main
import (
"fmt" "math" "sort" "time"
)
type term struct {
coeff int64 ix1, ix2 int8
}
const maxDigits = 18
func toInt64(digits []int8, reverse bool) int64 {
sum := int64(0) if !reverse { for i := 0; i < len(digits); i++ { sum = sum*10 + int64(digits[i]) } } else { for i := len(digits) - 1; i >= 0; i-- { sum = sum*10 + int64(digits[i]) } } return sum
}
func isSquare(n int64) bool {
if 0x202021202030213&(1<<(n&63)) != 0 { root := int64(math.Sqrt(float64(n))) return root*root == n } return false
}
func seq(from, to, step int8) []int8 {
var res []int8 for i := from; i <= to; i += step { res = append(res, i) } return res
}
func commatize(n int64) string {
s := fmt.Sprintf("%d", n) le := len(s) for i := le - 3; i >= 1; i -= 3 { s = s[0:i] + "," + s[i:] } return s
}
func main() {
start := time.Now() pow := int64(1) fmt.Println("Aggregate timings to process all numbers up to:") // terms of (n-r) expression for number of digits from 2 to maxDigits allTerms := make([][]term, maxDigits-1) for r := 2; r <= maxDigits; r++ { var terms []term pow *= 10 pow1, pow2 := pow, int64(1) for i1, i2 := int8(0), int8(r-1); i1 < i2; i1, i2 = i1+1, i2-1 { terms = append(terms, term{pow1 - pow2, i1, i2}) pow1 /= 10 pow2 *= 10 } allTerms[r-2] = terms } // map of first minus last digits for 'n' to pairs giving this value fml := map[int8][][]int8{ 0: {{2, 2}, {8, 8}}, 1: {{6, 5}, {8, 7}}, 4: Template:4, 0, 6: {{6, 0}, {8, 2}}, } // map of other digit differences for 'n' to pairs giving this value dmd := make(map[int8][][]int8) for i := int8(0); i < 100; i++ { a := []int8{i / 10, i % 10} d := a[0] - a[1] dmd[d] = append(dmd[d], a) } fl := []int8{0, 1, 4, 6} dl := seq(-9, 9, 1) // all differences zl := []int8{0} // zero differences only el := seq(-8, 8, 2) // even differences only ol := seq(-9, 9, 2) // odd differences only il := seq(0, 9, 1) var rares []int64 lists := make([][][]int8, 4) for i, f := range fl { lists[i] = [][]int8Template:F } var digits []int8 count := 0
// Recursive closure to generate (n+r) candidates from (n-r) candidates // and hence find Rare numbers with a given number of digits. var fnpr func(cand, di []int8, dis [][]int8, indices [][2]int8, nmr int64, nd, level int) fnpr = func(cand, di []int8, dis [][]int8, indices [][2]int8, nmr int64, nd, level int) { if level == len(dis) { digits[indices[0][0]] = fml[cand[0]][di[0]][0] digits[indices[0][1]] = fml[cand[0]][di[0]][1] le := len(di) if nd%2 == 1 { le-- digits[nd/2] = di[le] } for i, d := range di[1:le] { digits[indices[i+1][0]] = dmd[cand[i+1]][d][0] digits[indices[i+1][1]] = dmd[cand[i+1]][d][1] } r := toInt64(digits, true) npr := nmr + 2*r if !isSquare(npr) { return } count++ fmt.Printf(" R/N %2d:", count) fmt.Printf(" %9s ms", commatize(time.Since(start).Milliseconds())) n := toInt64(digits, false) fmt.Printf(" (%s)\n", commatize(n)) rares = append(rares, n) } else { for _, num := range dis[level] { di[level] = num fnpr(cand, di, dis, indices, nmr, nd, level+1) } } }
// Recursive closure to generate (n-r) candidates with a given number of digits. var fnmr func(cand []int8, list [][]int8, indices [][2]int8, nd, level int) fnmr = func(cand []int8, list [][]int8, indices [][2]int8, nd, level int) { if level == len(list) { nmr := int64(0) for i, t := range allTerms[nd-2] { nmr += t.coeff * int64(cand[i]) } if nmr <= 0 || !isSquare(nmr) { return } var dis [][]int8 dis = append(dis, seq(0, int8(len(fml[cand[0]]))-1, 1)) for i := 1; i < len(cand); i++ { dis = append(dis, seq(0, int8(len(dmd[cand[i]]))-1, 1)) } if nd%2 == 1 { dis = append(dis, il) } di := make([]int8, len(dis)) fnpr(cand, di, dis, indices, nmr, nd, 0) } else { for _, num := range list[level] { cand[level] = num fnmr(cand, list, indices, nd, level+1) } } }
for nd := 2; nd <= maxDigits; nd++ { digits = make([]int8, nd) if nd == 4 { lists[0] = append(lists[0], zl) lists[1] = append(lists[1], ol) lists[2] = append(lists[2], el) lists[3] = append(lists[3], ol) } else if len(allTerms[nd-2]) > len(lists[0]) { for i := 0; i < 4; i++ { lists[i] = append(lists[i], dl) } } var indices [][2]int8 for _, t := range allTerms[nd-2] { indices = append(indices, [2]int8{t.ix1, t.ix2}) } for _, list := range lists { cand := make([]int8, len(list)) fnmr(cand, list, indices, nd, 0) } fmt.Printf(" %2d digits: %9s ms\n", nd, commatize(time.Since(start).Milliseconds())) }
sort.Slice(rares, func(i, j int) bool { return rares[i] < rares[j] }) fmt.Printf("\nThe rare numbers with up to %d digits are:\n", maxDigits) for i, rare := range rares { fmt.Printf(" %2d: %23s\n", i+1, commatize(rare)) }
}</lang>
- Output:
Timings are for an Intel Core i7-8565U machine with 32GB RAM running Go 1.13.1 on Ubuntu 18.04.
Aggregate timings to process all numbers up to: R/N 1: 0 ms (65) 2 digits: 0 ms 3 digits: 0 ms 4 digits: 0 ms 5 digits: 0 ms R/N 2: 1 ms (621,770) 6 digits: 1 ms 7 digits: 2 ms 8 digits: 15 ms R/N 3: 15 ms (281,089,082) 9 digits: 20 ms R/N 4: 20 ms (2,022,652,202) R/N 5: 59 ms (2,042,832,002) 10 digits: 99 ms 11 digits: 137 ms R/N 6: 361 ms (872,546,974,178) R/N 7: 389 ms (872,568,754,178) R/N 8: 738 ms (868,591,084,757) 12 digits: 888 ms R/N 9: 1,130 ms (6,979,302,951,885) 13 digits: 1,446 ms R/N 10: 4,990 ms (20,313,693,904,202) R/N 11: 5,058 ms (20,313,839,704,202) R/N 12: 6,475 ms (20,331,657,922,202) R/N 13: 6,690 ms (20,331,875,722,202) R/N 14: 7,293 ms (20,333,875,702,202) R/N 15: 16,685 ms (40,313,893,704,200) R/N 16: 16,818 ms (40,351,893,720,200) 14 digits: 17,855 ms R/N 17: 17,871 ms (200,142,385,731,002) R/N 18: 18,079 ms (221,462,345,754,122) R/N 19: 20,774 ms (816,984,566,129,618) R/N 20: 22,155 ms (245,518,996,076,442) R/N 21: 22,350 ms (204,238,494,066,002) R/N 22: 22,413 ms (248,359,494,187,442) R/N 23: 22,687 ms (244,062,891,224,042) R/N 24: 26,698 ms (403,058,392,434,500) R/N 25: 26,905 ms (441,054,594,034,340) 15 digits: 27,932 ms R/N 26: 77,599 ms (2,133,786,945,766,212) R/N 27: 96,932 ms (2,135,568,943,984,212) R/N 28: 99,869 ms (8,191,154,686,620,818) R/N 29: 102,401 ms (8,191,156,864,620,818) R/N 30: 103,535 ms (2,135,764,587,964,212) R/N 31: 105,255 ms (2,135,786,765,764,212) R/N 32: 109,232 ms (8,191,376,864,400,818) R/N 33: 122,372 ms (2,078,311,262,161,202) R/N 34: 148,814 ms (8,052,956,026,592,517) R/N 35: 153,226 ms (8,052,956,206,592,517) R/N 36: 185,251 ms (8,650,327,689,541,457) R/N 37: 187,467 ms (8,650,349,867,341,457) R/N 38: 189,163 ms (6,157,577,986,646,405) R/N 39: 217,112 ms (4,135,786,945,764,210) R/N 40: 230,719 ms (6,889,765,708,183,410) 16 digits: 231,583 ms R/N 41: 236,505 ms (86,965,750,494,756,968) R/N 42: 237,391 ms (22,542,040,692,914,522) R/N 43: 351,728 ms (67,725,910,561,765,640) 17 digits: 360,678 ms R/N 44: 392,403 ms (284,684,666,566,486,482) R/N 45: 513,738 ms (225,342,456,863,243,522) R/N 46: 558,603 ms (225,342,458,663,243,522) R/N 47: 653,047 ms (225,342,478,643,243,522) R/N 48: 718,569 ms (284,684,868,364,486,482) R/N 49: 1,087,602 ms (871,975,098,681,469,178) R/N 50: 1,763,809 ms (865,721,270,017,296,468) R/N 51: 1,779,059 ms (297,128,548,234,950,692) R/N 52: 1,787,466 ms (297,128,722,852,950,692) R/N 53: 1,888,803 ms (811,865,096,390,477,018) R/N 54: 1,940,347 ms (297,148,324,656,930,692) R/N 55: 1,965,331 ms (297,148,546,434,930,692) R/N 56: 2,273,287 ms (898,907,259,301,737,498) R/N 57: 2,657,073 ms (631,688,638,047,992,345) R/N 58: 2,682,636 ms (619,431,353,040,136,925) R/N 59: 2,948,725 ms (619,631,153,042,134,925) R/N 60: 3,011,962 ms (633,288,858,025,996,145) R/N 61: 3,077,937 ms (633,488,632,647,994,145) R/N 62: 3,928,545 ms (653,488,856,225,994,125) R/N 63: 4,195,016 ms (497,168,548,234,910,690) 18 digits: 4,445,897 ms The rare numbers with up to 18 digits are: 1: 65 2: 621,770 3: 281,089,082 4: 2,022,652,202 5: 2,042,832,002 6: 868,591,084,757 7: 872,546,974,178 8: 872,568,754,178 9: 6,979,302,951,885 10: 20,313,693,904,202 11: 20,313,839,704,202 12: 20,331,657,922,202 13: 20,331,875,722,202 14: 20,333,875,702,202 15: 40,313,893,704,200 16: 40,351,893,720,200 17: 200,142,385,731,002 18: 204,238,494,066,002 19: 221,462,345,754,122 20: 244,062,891,224,042 21: 245,518,996,076,442 22: 248,359,494,187,442 23: 403,058,392,434,500 24: 441,054,594,034,340 25: 816,984,566,129,618 26: 2,078,311,262,161,202 27: 2,133,786,945,766,212 28: 2,135,568,943,984,212 29: 2,135,764,587,964,212 30: 2,135,786,765,764,212 31: 4,135,786,945,764,210 32: 6,157,577,986,646,405 33: 6,889,765,708,183,410 34: 8,052,956,026,592,517 35: 8,052,956,206,592,517 36: 8,191,154,686,620,818 37: 8,191,156,864,620,818 38: 8,191,376,864,400,818 39: 8,650,327,689,541,457 40: 8,650,349,867,341,457 41: 22,542,040,692,914,522 42: 67,725,910,561,765,640 43: 86,965,750,494,756,968 44: 225,342,456,863,243,522 45: 225,342,458,663,243,522 46: 225,342,478,643,243,522 47: 284,684,666,566,486,482 48: 284,684,868,364,486,482 49: 297,128,548,234,950,692 50: 297,128,722,852,950,692 51: 297,148,324,656,930,692 52: 297,148,546,434,930,692 53: 497,168,548,234,910,690 54: 619,431,353,040,136,925 55: 619,631,153,042,134,925 56: 631,688,638,047,992,345 57: 633,288,858,025,996,145 58: 633,488,632,647,994,145 59: 653,488,856,225,994,125 60: 811,865,096,390,477,018 61: 865,721,270,017,296,468 62: 871,975,098,681,469,178 63: 898,907,259,301,737,498
Julia
Pretty slow to get 8 rare numbers, even if the squares are checked via table. <lang julia>fixeddigits = Dict(2 => [[0, 0, 2], [8, 8, 2]], 4 => 0, 0, 0,
6 => [[2, 7, 0], [9, 8, 5]], 8 => [[6, 5, 7],[7, 7, 8]])
squares = Dict([i * i => 1 for i in 1:1500000])
i2dig(i) = (d = Int[]; while i > 0 i, r = divrem(i, 10); push!(d, r) end; d) dig2i(d) = (n = 0; for i in d n = 10 * n + i end; n)
function simplegetrare(upto)
ret = Int[] for n in 0:upto dig = i2dig(n) r = dig2i(dig) nrsum, nrdiff = n + r, n - r if nrdiff > 0 && haskey(squares, nrsum) && haskey(squares, nrdiff) push!(ret, n) end end ret
end
function getrare(N)
ret = simplegetrare(20000) for i in 0:typemax(Int) basedigits = i2dig(i) for a in [2,4,6,8], (b, p, q) in fixeddigits[a] dig = [[q, p]; basedigits; [b, a]] r = dig2i(dig) n = dig2i(reverse(dig)) nrsum, nrdiff = n + r, n - r if nrdiff > 0 && haskey(squares, nrsum) && haskey(squares, nrdiff) push!(ret, n) if length(ret) >= N return ret end end end end
end
getrare(3) @time println("The first 8 rare numbers are: ", sort(getrare(8)))
</lang>
- Output:
The first 8 rare numbers are: [65, 621770, 281089082, 2022652202, 2042832002, 868591084757, 872546974178, 872568754178] 1379.707737 seconds (9.36 G allocations: 545.177 GiB, 2.25% gc time)
REXX
(See the discussion page for a simplistic 1st version that computes rare numbers only using the task's basic rules).
Most of the hints (properties of rare numbers) within Shyam Sunder Gupta's webpage have been incorporated in this
REXX program and the logic is now expressed within the list of AB...PQ (abutted numbers within the @g list).
These improvements made this REXX version around 25% faster than the previous version (see the discussion page). <lang rexx>/*REXX program calculates and displays a specified amount of rare numbers. */ numeric digits 20; w= digits() + digits() % 3 /*use enough dec. digs for calculations*/ parse arg many . /*obtain optional argument from the CL.*/ if many== | many=="," then many= 5 /*Not specified? Then use the default.*/ @g= 2002 2112 2222 2332 2442 2552 2662 2772 2882 2992 4000 4010 4030 4050 4070 4090 4100 ,
4110 4120 4140 4160 4180 4210 4230 4250 4270 4290 4300 4320 4340 4360 4380 4410 4430 , 4440 4450 4470 4490 4500 4520 4540 4560 4580 4610 4630 4650 4670 4690 4700 4720 4740 , 4760 4780 4810 4830 4850 4870 4890 4900 4920 4940 4960 4980 4990 6010 6015 6030 6035 , 6050 6055 6070 6075 6090 6095 6100 6105 6120 6125 6140 6145 6160 6165 6180 6185 6210 , 6215 6230 6235 6250 6255 6270 6275 6290 6295 6300 6305 6320 6325 6340 6345 6360 6365 , 6380 6385 6410 6415 6430 6435 6450 6455 6470 6475 6490 6495 6500 6505 6520 6525 6540 , 6545 6560 6565 6580 6585 6610 6615 6630 6635 6650 6655 6670 6675 6690 6695 6700 6705 , 6720 6725 6740 6745 6760 6765 6780 6785 6810 6815 6830 6835 6850 6855 6870 6875 6890 , 6895 6900 6905 6920 6925 6940 6945 6960 6965 6980 6985 8007 8008 8017 8027 8037 8047 , 8057 8067 8077 8087 8092 8097 8107 8117 8118 8127 8137 8147 8157 8167 8177 8182 8187 , 8197 8228 8272 8297 8338 8362 8387 8448 8452 8477 8542 8558 8567 8632 8657 8668 8722 , 8747 8778 8812 8837 8888 8902 8927 8998 /*4 digit abutted numbers for AB and PQ*/
@g#= words(@g)
/* [↓]─────────────────boolean arrays are used for checking for digit presence.*/
@dr.=0; @dr.2= 1; @dr.5=1 ; @dr.8= 1; @dr.9= 1 /*rare # must have these digital roots.*/ @ps.=0; @ps.2= 1; @ps.3= 1; @ps.7= 1; @ps.8= 1 /*perfect squares must end in these.*/ @149.=0; @149.1=1; @149.4=1; @149.9=1 /*values for Z that need an even Y. */ @odd.=0; do i=-9 by 2 to 9; @odd.i=1 /* " " N " " " " A. */
end /*i*/
@gen.=0; do i=1 for words(@g); parse value word(@g,i) with a 2 b 3 p 4 q; @gen.a.b.p.q=1
/*# AB···PQ could be a good rare value*/ end /*i*/
div9= 9 /*dif must be ÷ 9 when N has even #digs*/ evenN= \ (10 // 2) /*initial value for evenness of N. */
- = 0 /*the number of rare numbers (so far)*/
do n=10 /*Why 10? All 1 dig #s are palindromic*/ parse var n a 2 b 3 -2 p +1 q /*get 1st\2nd\penultimate\last digits. */ if @odd.a then do; n=n+10**(length(n)-1)-1 /*bump N so next N starts with even dig*/ evenN=\(length(n+1)//2) /*flag when N has an even # of digits. */ if evenN then div9= 9 /*when dif isn't divisible by 9 ... */ else div9= 99 /* " " " " " 99 " */ iterate /*let REXX do its thing with DO loop.*/ end /* {it's allowed to modify a DO index} */ if \@gen.a.b.p.q then iterate /*can N not be a rare AB···PQ number?*/ r= reverse(n) /*obtain the reverse of the number N. */ if r>n then iterate /*Difference will be negative? Skip it*/ if n==r then iterate /*Palindromic? Then it can't be rare.*/ dif= n-r; parse var dif -2 y +1 z /*obtain the last 2 digs of difference.*/ if @ps.z then iterate /*Not 0, 1, 4, 5, 6, 9? Not perfect sq.*/ select when z==0 then if y\==0 then iterate /*Does Z = 0? Then Y must be zero. */ when z==5 then if y\==2 then iterate /*Does Z = 5? Then Y must be two. */ when z==6 then if y//2==0 then iterate /*Does Z = 6? Then Y must be odd. */ otherwise if @149.z then if y//2 then iterate /*Z=1,4,9? Y must be even*/ end /*select*/ /* [↑] the OTHERWISE handles Z=8 case.*/ if dif//div9\==0 then iterate /*Difference isn't ÷ by div9? Then skip*/ sum= n+r; parse var sum -2 y +1 z /*obtain the last two digits of the sum*/ if @ps.z then iterate /*Not 0, 2, 5, 8, or 9? Not perfect sq.*/ select when z==0 then if y\==0 then iterate /*Does Z = 0? Then Y must be zero. */ when z==5 then if y\==2 then iterate /*Does Z = 5? Then Y must be two. */ when z==6 then if y//2==0 then iterate /*Does Z = 6? Then Y must be odd. */ otherwise if @149.z then if y//2 then iterate /*Z=1,4,9? Y must be even*/ end /*select*/ /* [↑] the OTHERWISE handles Z=8 case.*/ if evenN then if sum//11 \==0 then iterate /*N has even #digs? Sum must be ÷ by 11*/ $= a + b /*a head start on figuring digital root*/ do k=3 for length(n) - 2 /*now, process the rest of the digits. */ $= $ + substr(n, k, 1) /*add the remainder of the digits in N.*/ end /*k*/ do while $>9 /* [◄] Algorithm is good for 111 digs.*/ if $>9 then $= left($,1) + substr($,2,1) + substr($,3,1,0) /*>9? Reduce it.*/ end /*while*/ if \@dr.$ then iterate /*Doesn't have good digital root? Skip*/ if iSqrt(sum)**2 \== sum then iterate /*Not a perfect square? Then skip it. */ if iSqrt(dif)**2 \== dif then iterate /* " " " " " " " */ #= # + 1; call tell /*bump rare number counter; display #.*/ if #>=many then leave /* [↑] W: the width of # with commas.*/ end /*n*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ commas: parse arg _; do jc=length(_)-3 to 1 by -3; _=insert(',', _, jc); end; return _ tell: say right(th(#),length(#)+9) ' rare number is:' right(commas(n),w); return th: parse arg th;return th||word('th st nd rd',1+(th//10)*(th//100%10\==1)*(th//10<4)) /*──────────────────────────────────────────────────────────────────────────────────────*/ iSqrt: parse arg x; $= 0; q= 1; do while q<=x; q=q*4; end
do while q>1; q=q%4; _= x-$-q; $= $%2; if _>=0 then do; x=_; $=$+q; end end /*while q>1*/; return $</lang>
- output when using the input of: 8
1st rare number is: 65 2nd rare number is: 621,770 3rd rare number is: 281,089,082 4th rare number is: 2,022,652,202 5th rare number is: 2,042,832,002 6th rare number is: 868,591,084,757 7th rare number is: 872,546,974,178 8th rare number is: 872,568,754,178