N-smooth numbers: Difference between revisions

→‎{{header|Factor}}: Add F# language versions...
(tidy)
(→‎{{header|Factor}}: Add F# language versions...)
Line 1,258:
end.
</syntaxhighlight>
 
=={{header|F_Sharp|F#}}==
 
The easy way to solve this is just to translate the Haskell contribution as from "Hamming Numbers without duplicates", along with a version of a trial division small primes determination since the required primes have such a small range, as follows:
<syntaxhighlight lang="fsharp">let primesTo n =
if n < 3 then (if n < 2 then Seq.empty else Seq.singleton 2) else
let rec oddPrimesTo on =
let sqrtlmt = double on |> sqrt |> truncate |> int
let obps = if sqrtlmt < 3 then Seq.empty else oddPrimesTo sqrtlmt
let ns = [ 3 .. 2 .. on ]
let filtfnc fn = Seq.forall (fun bp -> bp * bp > fn ||
fn % bp <> 0) obps
Seq.filter filtfnc ns
Seq.append (Seq.singleton 2) (oddPrimesTo n)
 
type LazyList<'a> = Cons of 'a * Lazy<LazyList<'a>>
 
// Doesn't need to be that efficient for the task...
#nowarn "40" // don't need to warn for recursive values
let smooths p =
if p < 2 then Seq.singleton (bigint 1) else
let smthprms = primesTo p |> Seq.rev |> Seq.map bigint
let frstp = Seq.head smthprms
let rstps = Seq.tail smthprms
let frstll =
let rec nxt n =
Cons(n, lazy nxt (n * frstp))
nxt frstp
let smult m lzylst =
let rec smlt (Cons(x, rxs)) =
Cons(m * x, lazy(smlt (rxs.Force())))
smlt lzylst
let rec merge (Cons(x, f) as xs) (Cons(y, g) as ys) =
if x < y then Cons(x, lazy(merge (f.Force()) ys))
else Cons(y, lazy(merge xs (g.Force())))
let u s n =
let rec r = merge s (smult n (Cons(1I, lazy r))) in r
Seq.unfold (fun (Cons(hd, rst)) -> Some (hd, rst.Value))
(Cons(1I, lazy(Seq.fold u frstll rstps)))
 
let strt = System.DateTime.Now.Ticks
 
primesTo 29 |> Seq.iter (fun p ->
printfn "First 25 %d-smooth:" p
smooths p |> Seq.take 25 |> Seq.toList |> printfn "%A\r\n")
 
primesTo 29 |> Seq.skip 1 |> Seq.iter (fun p ->
printfn "The first three from the 3,000th %d-smooth numbers are:" p
smooths p |> Seq.skip 2999 |> Seq.take 3 |> Seq.toList |> printfn "%A\r\n")
 
primesTo 521 |> Seq.skipWhile ((>) 503) |> Seq.iter (fun p ->
printfn "The first 20 30,000th up %d-smooth numbers are:" p
smooths p |> Seq.skip 29999 |> Seq.take 20 |> Seq.toList |> printfn "%A\r\n")
 
let stop = System.DateTime.Now.Ticks
printfn "This took %d milliseconds." ((stop - strt) / 10000L)</syntaxhighlight>
{{out}}
<pre>First 25 2-smooth:
[1; 2; 4; 8; 16; 32; 64; 128; 256; 512; 1024; 2048; 4096; 8192; 16384; 32768;
65536; 131072; 262144; 524288; 1048576; 2097152; 4194304; 8388608; 16777216]
 
First 25 3-smooth:
[1; 2; 3; 4; 6; 8; 9; 12; 16; 18; 24; 27; 32; 36; 48; 54; 64; 72; 81; 96; 108;
128; 144; 162; 192]
 
First 25 5-smooth:
[1; 2; 3; 4; 5; 6; 8; 9; 10; 12; 15; 16; 18; 20; 24; 25; 27; 30; 32; 36; 40; 45;
48; 50; 54]
 
First 25 7-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 12; 14; 15; 16; 18; 20; 21; 24; 25; 27; 28; 30;
32; 35; 36]
 
First 25 11-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 14; 15; 16; 18; 20; 21; 22; 24; 25; 27;
28; 30; 32]
 
First 25 13-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 18; 20; 21; 22; 24; 25;
26; 27; 28]
 
First 25 17-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 20; 21; 22; 24;
25; 26; 27]
 
First 25 19-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22;
24; 25; 26]
 
First 25 23-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22;
23; 24; 25]
 
First 25 29-smooth:
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22;
23; 24; 25]
 
The first three from the 3,000th 3-smooth numbers are:
[91580367978306252441724649472; 92829823186414819915547541504;
94096325042746502515294076928]
 
The first three from the 3,000th 5-smooth numbers are:
[278942752080; 279936000000; 281250000000]
 
The first three from the 3,000th 7-smooth numbers are:
[50176000; 50331648; 50388480]
 
The first three from the 3,000th 11-smooth numbers are:
[2112880; 2116800; 2117016]
 
The first three from the 3,000th 13-smooth numbers are:
[390000; 390390; 390625]
 
The first three from the 3,000th 17-smooth numbers are:
[145800; 145860; 146016]
 
The first three from the 3,000th 19-smooth numbers are:
[74256; 74358; 74360]
 
The first three from the 3,000th 23-smooth numbers are:
[46552; 46575; 46585]
 
The first three from the 3,000th 29-smooth numbers are:
[33516; 33524; 33534]
 
The first 20 30,000th up 503-smooth numbers are:
[62913; 62914; 62916; 62918; 62920; 62923; 62926; 62928; 62930; 62933; 62935;
62937; 62944; 62946; 62951; 62952; 62953; 62957; 62959; 62964]
 
The first 20 30,000th up 509-smooth numbers are:
[62601; 62602; 62604; 62607; 62608; 62609; 62611; 62618; 62620; 62622; 62624;
62625; 62626; 62628; 62629; 62634; 62640; 62643; 62645; 62646]
 
The first 20 30,000th up 521-smooth numbers are:
[62287; 62288; 62291; 62292; 62300; 62304; 62307; 62308; 62310; 62315; 62320;
62321; 62322; 62325; 62328; 62329; 62330; 62331; 62335; 62336]
 
This took 544 milliseconds.</pre>
As run on an Intel i5-6500 (3.6 GHz boosted when single-threaded), this isn't particularly fast, slowed by DotNet's poor allocation/deallocation of small memory area performance as required here for the "LazyList" implementation (a new allocation for each element) as well as the time to process the deferred execution "thunks" required for memoization, and also because the "BigInt" implementation isn't likely as fast as the "native" implementation used by some languages such as Haskell (by default).
 
'''Faster Non-recursive Version'''
 
The following code is over twice as fast because it no longer requires a memoized "LazyList" but just the deferred-execution tails of a Co-Inductive Stream (CIS), although to be general it still uses these streams for each merged CIS of the accumulated intermediate result streams, meaning that it still uses many allocations/deallocations for each CIS element; as well, it avoids some of the slow F# "Seq" operations by directly manipulating the "CIS" streams:
<syntaxhighlight lang="fsharp">let primesTo n =
if n < 3 then (if n < 2 then Seq.empty else Seq.singleton 2) else
let rec oddPrimesTo on =
let sqrtlmt = double on |> sqrt |> truncate |> int
let obps = if sqrtlmt < 3 then Seq.empty else oddPrimesTo sqrtlmt
let ns = [ 3 .. 2 .. on ]
let filtfnc fn = Seq.forall (fun bp -> bp * bp > fn ||
fn % bp <> 0) obps
Seq.filter filtfnc ns
Seq.append (Seq.singleton 2) (oddPrimesTo n)
 
type CIS<'a> = CIS of 'a * (Unit -> CIS<'a>)
 
let rec skipCIS n (CIS(_, tlf) as cis) =
if n <= 0 then cis else skipCIS (n - 1) (tlf())
 
let stringCIS n (CIS(fhd, ftlf)) =
let rec addstr i (CIS(hd, tlf)) str =
if i <= 0 then str + " )"
else addstr (i - 1) (tlf()) (str + ", " + string hd)
addstr (n - 1) (ftlf()) ("( " + string fhd)
 
type Deque<'a> = Deque of int * int * int * 'a array
 
let makeDQ v =
let arr = Array.zeroCreate 1024 in arr.[0] <- v
Deque(1023, 0, 1, arr)
 
let growDQ (Deque(msk, hdi, tli, arr)) =
let sz = arr.Length
let nsz = if sz = 0 then 1024 else sz + sz
let narr = Array.zeroCreate nsz
let nhdi, ntli =
if hdi = 0 then Array.blit arr 0 narr 0 sz
hdi, sz
else let mv = hdi + sz // move top queue up...
Array.blit arr 0 narr 0 tli
Array.blit arr hdi narr mv (sz - hdi)
mv, tli
Deque(nsz - 1, nhdi, ntli, narr)
 
let pushDQ v (Deque(_, hdi, tli, _) as dq) =
let (Deque(nmsk, nhdi, ntli, narr)) = if tli <> hdi then dq
else growDQ dq
narr.[ntli] <- v
Deque(nmsk, nhdi, (ntli + 1) &&& nmsk, narr)
 
// Deque is never empty after the first push and always push before pull!
let inline peekDQ (Deque(_, hdi, _, arr)) = arr.[hdi]
let pullDQ (Deque(msk, hdi, tli, arr)) =
Deque(msk, (hdi + 1) &&& msk, tli, arr)
 
let smoothsNR p =
// if p < 2 then Seq.singleton (bigint 1) else
let smthprms = primesTo p |> Seq.rev |> Seq.map bigint
let frstp = Seq.head smthprms
let rstps = Seq.tail smthprms
let frstcis =
let rec nxt n =
CIS(n, fun () -> nxt (n * frstp)) in nxt frstp
let nxt dq =
Seq.initInfinite ((+) 1I << bigint)
let newcis cis p =
let rec nxt (CIS(hd, tlf) as cs) dq =
let nxtq = peekDQ dq
if hd < nxtq then CIS(hd, fun () -> nxt (tlf()) (pushDQ (hd * p) dq))
else CIS(nxtq, fun () -> nxt cs (pushDQ (nxtq * p) dq |> pullDQ))
CIS(p, fun () -> nxt cis (makeDQ (p * p)))
CIS(1I, fun () -> Seq.fold newcis frstcis rstps)
 
let strt = System.DateTime.Now.Ticks
 
primesTo 29 |> Seq.iter (fun p ->
printfn "First 25 %d-smooth:" p
smoothsNR p |> stringCIS 25 |> printfn "%s\r\n")
 
primesTo 29 |> Seq.skip 1 |> Seq.iter (fun p ->
printfn "The first three from the 3,000th %d-smooth numbers are:" p
smoothsNR p |> skipCIS 2999 |> stringCIS 3 |> printfn "%s\r\n")
 
primesTo 521 |> Seq.skipWhile ((>) 503) |> Seq.iter (fun p ->
printfn "The first 20 from the 30,000th up %d-smooth numbers are:" p
smoothsNR p |> skipCIS 29999 |> stringCIS 20 |> printfn "%s\r\n")
 
let stop = System.DateTime.Now.Ticks
printfn "This took %d milliseconds." ((stop - strt) / 10000L)</syntaxhighlight>
 
=={{header|Factor}}==
474

edits