Hamming numbers: Difference between revisions

→‎{{header|ERRE}}: add Elm version before...
(→‎{{header|Quackery}}: Found the N-smooth numbers task. Reusing code is good. :-))
(→‎{{header|ERRE}}: add Elm version before...)
Line 3,691:
519312780448388736089589843750000000000000000000000000000000000000000000000000000000
</pre>
 
=={{header|Elm}}==
 
The Elm language has many restrictions that make the implementation of the Hamming Number sequence algorithms difficult, as the classic Edsger Dijkstra algorithm as written in Haskell [[Hamming_numbers#The_classic_version]] cannot be written in Elm as current Elm forbids cyclic value references (the value "hamming" is back referenced three times), and the implementation wouldn't be efficient even if it could as the current Elm version 0.19.x has removed the "Lazy" package the would defer the memoization of the result of a computation as necessary in implementing Haskell's lazy lists. Thus, one has to implement memoization using a different data structure than a lazy list; however, all current Elm data structures forbid mutation and can only implement some sort of Copy On Write (COW), thus there is no implementation of a linear array and the "Array" module is a tree based structure (with some concessions to data blocks for slightly better performance) that will have a logarithmic execution complexity when the size increases above a minimum. In fact, all Elm data structures that could be used for this also have a logarithmic response (Dict, Set, Array). The implementation of List is not lazy so new elements can't be added to the "tail" but need to be added to the "head" for efficiency, which means if one wants to add higher elements to a list in increasing order, one needs to (COW) reverse the List (twice) in order to do it!
 
The solution here uses a pure functional implementation of a Min Heap (Binary Heap) Priority Queue so that the minimum element can be viewed in O(1) time although inserting new elements/replacing elements still takes O(log n) time where "n" is the number of elements in the queue. As written, no queue needs to be maintained for the multiples of five, but two ques are maintained, one for the merge of the multiples of five and three, and the larger one for the merge of all the multiples of five, three, and two. In order to minimize redundant computation time, the implementation maintains the "next" comparison values as part of the recursive function loop states that can change with every loop.
 
To express the sequence, a Co-Inductive Stream (CIS) is used as a deferred execution (lazy) stream; it does not memoize computations (as discussed above) but that isn't necessary for this application where the sequence is only traversed once and consumed as being traversed.
 
In addition, in order to reduce the "BigInt" computation time, the calculations are done on the basis of a "Float" logarithmic approxitmation while maintaining "Trival" triple representation of the number of times two, three, and five, are multiplied in order to obtain the current value represented by the logarithmic approximation. The working code is as follows:
 
<lang elm>module Main exposing ( main )
 
import Bitwise exposing (..)
import BigInt
import Task exposing ( Task, succeed, perform, andThen )
import Html exposing (Html, div, text)
import Browser exposing ( element )
import Time exposing ( now, posixToMillis )
 
cLIMIT : Int
cLIMIT = 1000000
 
-- an infinite non-empty non-memoizing Co-Inductive Stream (CIS)...
type CIS a = CIS a (() -> CIS a)
 
takeCIS2List : Int -> CIS a -> List a
takeCIS2List n cis =
let loop i (CIS hd tl) lst =
if i < 1 then List.reverse lst
else loop (i - 1) (tl()) (hd :: lst)
in loop n cis []
 
nthCIS : Int -> CIS a -> a
nthCIS n (CIS hd tl) =
if n <= 1 then hd else nthCIS (n - 1) (tl())
 
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
 
type alias Trival = (Int, Int, Int)
showTrival : Trival -> String
showTrival tv =
let (x2, x3, x5) = tv
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 x2 (BigInt.fromInt 2)
|> xpnd x3 (BigInt.fromInt 3) |> xpnd x5 (BigInt.fromInt 5)
|> BigInt.toString
 
type alias LogRep = { lr: Float, trv: Trival }
ltLogRep : LogRep -> LogRep -> Bool
ltLogRep lra lrb = lra.lr < lrb.lr
oneLogRep : LogRep
oneLogRep = { lr = 0.0, trv = (0, 0, 0) }
lg2_2 : Float
lg2_2 = 1.0 -- log base two of two
lg2_3 : Float
lg2_3 = logBase 2.0 3.0
lg2_5 : Float
lg2_5 = logBase 2.0 5.0
multLR2 : LogRep -> LogRep
multLR2 lr = let (x2, x3, x5) = lr.trv
in LogRep (lr.lr + lg2_2) (x2 + 1, x3, x5)
multLR3 : LogRep -> LogRep
multLR3 lr = let (x2, x3, x5) = lr.trv
in LogRep (lr.lr + lg2_3) (x2, x3 + 1, x5)
multLR5 : LogRep -> LogRep
multLR5 lr = let (x2, x3, x5) = lr.trv
in LogRep (lr.lr + lg2_5) (x2, x3, x5 + 1)
 
hammingsLog : () -> CIS Trival
hammingsLog() =
let im235 = multLR2 oneLogRep
im35 = multLR3 oneLogRep
imrg = im35
im5 = multLR5 oneLogRep
next bpq mpq m235 mrg m35 m5 =
if ltLogRep m235 mrg then
let omin = case peekMinPQ bpq of
Just (lr, trv) -> LogRep lr trv
otherwise -> m235 -- at the beginning!
nm235 = multLR2 omin
nbpq = replaceMinPQ m235.lr m235.trv bpq
in CIS m235.trv <| \ () ->
next nbpq mpq nm235 mrg m35 m5
else
if ltLogRep mrg m5 then
let omin = case peekMinPQ mpq of
Just (lr, trv) -> LogRep lr trv
otherwise -> mrg -- at the beginning!
nm35 = multLR3 omin
nmrg = if ltLogRep nm35 m5 then nm35 else m5
nmpq = replaceMinPQ mrg.lr mrg.trv mpq
nbpq = pushPQ mrg.lr mrg.trv bpq
in CIS mrg.trv <| \ () ->
next nbpq nmpq m235 nmrg nm35 m5
else
let nm5 = multLR5 m5
nmrg = if ltLogRep m35 nm5 then m35 else nm5
nmpq = pushPQ m5.lr m5.trv mpq
nbpq = pushPQ m5.lr m5.trv bpq
in CIS m5.trv <| \ () ->
next nbpq nmpq m235 nmrg m35 nm5
in CIS (0, 0, 0) <| \ () ->
next emptyPQ emptyPQ im235 imrg im35 im5
 
-- following code has to do with outputting to a web page using MUV/TEA...
 
type alias Model = { time: Int
, str1: String, str2: String, str3: String }
 
type Msg = Start Int | Done ( Int, Trival )
 
timemillis : () -> Task Never Int -- a side effect function
timemillis() = now |> andThen (\ t -> succeed (posixToMillis t))
 
test : Int -> Cmd Msg -- side effect function chain (includes "perform")...
test lmt =
timemillis()
|> andThen (\ t -> succeed ( t, nthCIS lmt (hammingsLog()) ))
|> perform Done
 
myupdate : Msg -> Model -> (Model, Cmd Msg)
myupdate msg mdl =
case msg of
Start tm -> ( Model tm mdl.str1 mdl.str2 "Running...", test cLIMIT )
Done (stptm, answr) ->
( ( Model stptm mdl.str1 mdl.str2
<| "The " ++ String.fromInt cLIMIT ++
"th Hamming number is " ++
showTrival answr ++ " in " ++
String.fromInt (stptm - mdl.time) ++
" milliseconds." )
, Cmd.none ) -- terminates computation; allows UI update...
 
myview : Model -> Html msg
myview mdl =
div [] [ div [] [text mdl.str1]
, div [] [text mdl.str2]
, div [] [text mdl.str3] ]
 
main : Program () Model Msg
main =
element { init = \ _ -> ( Model 0
("The first 20 Hamming numbers are: " ++
(hammingsLog() |> takeCIS2List 20
|> List.map showTrival
|> String.join ", ") ++ ".")
("The 1691st Hamming number is " ++
(hammingsLog() |> nthCIS 1691
|> showTrival) ++ ".")
"", perform Start (timemillis()) )
, update = myupdate
, subscriptions = \ _ -> Sub.none
, view = myview }</lang>
{{out}}
<pre>The first 20 Hamming numbers are: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36.
The 1691st Hamming number is 2125764000.
The 1000000th Hamming number is 519312780448388736089589843750000000000000000000000000000000000000000000000000000000 in 756 milliseconds.</pre>
 
Do note that, due to the logarithmic response of the Min Heap Priority Queue, the execution time is logarithmic with number of elements evaluation and not linear as it would otherwise be, so if it takes 0.7 seconds to find the millionth Hamming number, it takes something about 10 seconds to find the ten millionth value instead of about 7 seconds. Considering that the generated "native" code is just JavaScript, it is reasonably fast and competitive with easier implementations in other languages such as F#.
 
=={{header|ERRE}}==
474

edits