Humble numbers: Difference between revisions
→{{header|F_Sharp|F#}}: added Elm contribution above...
GordonBGood (talk | contribs) (→{{header|Haskell}}: add faster versions...) |
GordonBGood (talk | contribs) (→{{header|F_Sharp|F#}}: added Elm contribution above...) |
||
Line 2,295:
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Humble_numbers#Pascal Pascal].
=={{header|Elm}}==
As discussed [[Hamming_numbers#Elm|in the Elm Hamming numbers contribution]] and further limited here as to the fastest contribution [[Humble_numbers#Direct_Generation_of_Digit_Counts_from_Logarithms|in the Haskell Direct Generation contribution to this task]] due to not having an efficient random access read/write data structure such as a linear array, the implementation is limited to using a Minimum Heap binary queue [[N-smooth_numbers#Elm|as in the N-smooth Elm contribution]], which is reasonably fast using the logarithmic estimates for ordering of the sequence. The following code implements the task (the BigInt package has been installed from "cmditch/elm-bigint" as well as "elm/time"):
<syntaxhighlight lang="fsharp">module Main exposing (main)
import Browser
import Html exposing (div, pre, text, br)
import Task exposing (Task, succeed, andThen, perform)
import BigInt
import Bitwise exposing (shiftRightBy, and)
import Time exposing (now, posixToMillis)
-- an infinite non-empty non-memoizing Co-Inductive Stream (CIS)...
type CIS a = CIS a (() -> CIS a)
takeCIS2String : Int -> (a -> String) -> CIS a -> String
takeCIS2String n cvtf cis =
let loop i (CIS hd tl) lst =
if i < 1 then List.reverse lst |> String.join ", "
else loop (i - 1) (tl()) (cvtf hd :: lst)
in loop n cis []
-- a Min Heap binary heap Priority Queue...
type PriorityQ comparable v =
Mt
| Br comparable v (PriorityQ comparable v)
(PriorityQ comparable v)
emptyPQ : PriorityQ comparable v
emptyPQ = Mt
peekMinPQ : PriorityQ comparable v -> Maybe (comparable, v)
peekMinPQ pq = case pq of
(Br k v _ _) -> Just (k, v)
Mt -> Nothing
pushPQ : comparable -> v -> PriorityQ comparable v
-> PriorityQ comparable v
pushPQ wk wv pq =
case pq of
Mt -> Br wk wv Mt Mt
(Br vk vv pl pr) ->
if wk <= vk then Br wk wv (pushPQ vk vv pr) pl
else Br vk vv (pushPQ wk wv pr) pl
siftdown : comparable -> v -> PriorityQ comparable v
-> PriorityQ comparable v -> PriorityQ comparable v
siftdown wk wv pql pqr =
case pql of
Mt -> Br wk wv Mt Mt
(Br vkl vvl pll prl) ->
case pqr of
Mt -> if wk <= vkl then Br wk wv pql Mt
else Br vkl vvl (Br wk wv Mt Mt) Mt
(Br vkr vvr plr prr) ->
if wk <= vkl && wk <= vkr then Br wk wv pql pqr
else if vkl <= vkr then Br vkl vvl (siftdown wk wv pll prl) pqr
else Br vkr vvr pql (siftdown wk wv plr prr)
replaceMinPQ : comparable -> v -> PriorityQ comparable v
-> PriorityQ comparable v
replaceMinPQ wk wv pq = case pq of
Mt -> Mt
(Br _ _ pl pr) -> siftdown wk wv pl pr
-- actual humble function implementation...
type alias Mults = { x2 : Int, x3 : Int, x5 : Int, x7 : Int }
type alias LogRep = { lg : Float, mlts : Mults }
oneLogRep : LogRep
oneLogRep = LogRep 0.0 <| Mults 0 0 0 0
lg10 : Float
lg10 = 1.0
lg7 : Float
lg7 = logBase 10 7
lg5 : Float
lg5 = logBase 10.0 5.0
lg3 : Float
lg3 = logBase 10.0 3.0
lg2 : Float
lg2 = lg10 - lg5
multLR2 : LogRep -> LogRep
multLR2 ({ lg, mlts } as lr) =
{ lr | lg = lg + lg2, mlts = { mlts | x2 = mlts.x2 + 1 } }
multLR3 : LogRep -> LogRep
multLR3 ({ lg, mlts } as lr) =
{ lr | lg = lg + lg3, mlts = { mlts | x3 = mlts.x3 + 1 } }
multLR5 : LogRep -> LogRep
multLR5 ({ lg, mlts } as lr) =
{ lr | lg = lg + lg5, mlts = { mlts | x5 = mlts.x5 + 1 } }
multLR7 : LogRep -> LogRep
multLR7 ({ lg, mlts } as lr) =
{ lr | lg = lg + lg7, mlts = { mlts | x7 = mlts.x7 + 1 } }
showLogRep : LogRep -> String
showLogRep lr =
let xpnd x m r =
if x <= 0 then r
else xpnd (shiftRightBy 1 x) (BigInt.mul m m)
(if (and 1 x) /= 0 then BigInt.mul m r else r)
in BigInt.fromInt 1 |> xpnd lr.mlts.x2 (BigInt.fromInt 2)
|> xpnd lr.mlts.x3 (BigInt.fromInt 3) |> xpnd lr.mlts.x5 (BigInt.fromInt 5)
|> xpnd lr.mlts.x7 (BigInt.fromInt 7) |> BigInt.toString
humblesLog : () -> CIS LogRep
humblesLog() =
let prmfs = [multLR7, multLR5, multLR3, multLR2]
fprmf = List.head prmfs |> Maybe.withDefault identity -- never Nothing!
rstps = List.tail prmfs |> Maybe.withDefault [] -- never Nothing!
frstcis =
let nxt lr =
CIS lr <| \ _ -> nxt (fprmf lr)
in nxt (fprmf oneLogRep)
dflt = (0.0, Mults 0 0 0 0)
mkcis lrf cis =
let frst = lrf oneLogRep
scnd = lrf frst
nxt pq (CIS hd tlf as cs) =
let (lgv, v) = peekMinPQ pq |> Maybe.withDefault dflt in
if lgv < hd.lg then let lr = (LogRep lgv v) in CIS lr <| \ _ ->
let { lg, mlts } = lrf lr
in nxt (replaceMinPQ lg mlts pq) cs
else CIS hd <| \ _ ->
let { lg, mlts } = lrf hd
in nxt (pushPQ lg mlts pq) (tlf())
in CIS frst <| \ _ -> nxt (pushPQ scnd.lg scnd.mlts emptyPQ) cis
rest() = List.foldl mkcis frstcis rstps
in CIS oneLogRep <| \ _ -> rest()
-- pretty printing function to add commas every 3 chars from left...
comma3 : String -> String
comma3 s =
let go n lst =
if n < 1 then String.join "," lst else
let nn = max (n - 3) 0
in go nn (String.slice nn n s :: lst)
in go (String.length s) []
humbleDigitCountsTo : Int -> CIS LogRep -> List String
humbleDigitCountsTo n cis =
let go i (CIS hd tlf) cnt cacc lst =
if i >= n then List.reverse lst else
if truncate hd.lg <= i then go i (tlf()) (cnt + 1) cacc lst
else let ni = i + 1
ncacc = cacc + cnt
str =
(String.padLeft 4 ' ' << String.fromInt) ni
++ (String.padLeft 14 ' ' << comma3 << String.fromInt) cnt
++ (String.padLeft 19 ' ' << comma3 << String.fromInt) ncacc
in go ni (tlf()) 1 ncacc (str :: lst) -- always > 1 per dgt
in go 0 cis 0 0 []
-- code to do with testing...
timemillis : () -> Task Never Int -- a side effect function
timemillis() = now |> andThen (\ t -> succeed (posixToMillis t))
test : () -> Cmd Msg
test() =
let numdgt = 100
hdg1 = "The first 50 humble numbers are: "
msg1 = humblesLog() |> takeCIS2String 50 showLogRep
hdg2 = "Count of humble numbers for each digit length 1-"
++ String.fromInt numdgt ++ ":"
msg2 = "Digits Count Accum"
in timemillis()
|> Task.andThen (\ strt ->
let rslt = humblesLog() |> humbleDigitCountsTo numdgt
in timemillis()
|> Task.andThen (\ stop ->
succeed (((hdg1 ++ msg1) :: "" :: hdg2 :: msg2 :: rslt)
++ ["Counting took " ++ String.fromInt (stop - strt)
++ " milliseconds."])))
|> perform Done
-- following code has to do with outputting to a web page using MUV/TEA...
type alias Model = List String
type Msg = Done Model
main : Program () Model Msg
main = Browser.element
{ init = \ _ -> ([], test())
, update = \ (Done mdl) _ -> (mdl, Cmd.none)
, subscriptions = \ _ -> Sub.none
, view = div [] << List.map (\ s ->
if s == "" then br [] []
else pre [] <| List.singleton <| text s)
}</syntaxhighlight>
{{out}}
<pre>The first 50 humble numbers are: 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, 40, 42, 45, 48, 49, 50, 54, 56, 60, 63, 64, 70, 72, 75, 80, 81, 84, 90, 96, 98, 100, 105, 108, 112, 120
Count of humble numbers for each digit length 1-100:
Digits Count Accum
1 9 9
2 36 45
3 95 140
4 197 337
5 356 693
6 579 1,272
7 882 2,154
8 1,272 3,426
9 1,767 5,193
10 2,381 7,574
.
. abbreviated with full results checked as per the C++ contribution to this task.
.
90 1,463,862 33,914,307
91 1,512,840 35,427,147
92 1,562,897 36,990,044
93 1,614,050 38,604,094
94 1,666,302 40,270,396
95 1,719,669 41,990,065
96 1,774,166 43,764,231
97 1,829,805 45,594,036
98 1,886,590 47,480,626
99 1,944,540 49,425,166
100 2,003,661 51,428,827</pre>
This execution time is as run on an Intel i5-6500 at 3.6 GHz boosted for single-threading is perhaps thirty percent slower than if it would be with a loop value holding the minimum "head" value of the queue to avoid the overhead of "peek" operations on the queue when the test doesn't require other access to the queue as used in the Elm contribution to the Hamming numbers task page, but the advantage here is that the code is shorter and easier to read and understand. This code is slower than other languages, even for JavaScript, due to the `O(n log n)` asymptotic execution performance of the persistent priority queue implementation so execution time increases at worse than linear rates with the number of elements processed in the sequence.
=={{header|F_Sharp|F#}}==
Line 2,344 ⟶ 2,561:
There are 12759 humble numbers with 18 digits
</pre>
=={{header|Factor}}==
<syntaxhighlight lang="factor">USING: accessors assocs combinators deques dlists formatting fry
| |||