Sieve of Eratosthenes: Difference between revisions

=={{header|Elm}}==

The Elm language doesn't handle efficiently doing the Sieve of Eratosthenes (SoE) algorithm efficiently because it doesn't have directly accessible linear arrays and also does Copy On Write (COW) for every write to every location as well as a logarithmic process of updating as a "tree" to minimize the COW operations. Thus, there is better performance implementing the Richard Bird Tree Folding functional algorithm, as follows:

{{trans|Haskell}}

<lang elm>module Main exposing (main)

import Browser exposing (element)

import Task exposing (Task, succeed, perform, andThen)

import Html exposing (Html, div, text)

import Time exposing (now, posixToMillis)

type CIS a = CIS a (() -> CIS a)

uptoCIS2List : comparable -> CIS comparable -> List comparable

uptoCIS2List n cis =

let loop (CIS hd tl) lst =

if hd > n then List.reverse lst

else loop (tl()) (hd :: lst)

in loop cis []

countCISTo : comparable -> CIS comparable -> Int

countCISTo n cis =

let loop (CIS hd tl) cnt =

if hd > n then cnt else loop (tl()) (cnt + 1)

in loop cis 0

primesTreeFolding : () -> CIS Int

primesTreeFolding() =

let

merge (CIS x xtl as xs) (CIS y ytl as ys) =

case compare x y of

LT -> CIS x <| \ () -> merge (xtl()) ys

EQ -> CIS x <| \ () -> merge (xtl()) (ytl())

GT -> CIS y <| \ () -> merge xs (ytl())

pmult bp =

let adv = bp + bp

pmlt p = CIS p <| \ () -> pmlt (p + adv)

in pmlt (bp * bp)

allmlts (CIS bp bptl) =

CIS (pmult bp) <| \ () -> allmlts (bptl())

pairs (CIS frst tls) =

let (CIS scnd tlss) = tls()

in CIS (merge frst scnd) <| \ () -> pairs (tlss())

cmpsts (CIS (CIS hd tl) tls) =

CIS hd <| \ () -> merge (tl()) <| cmpsts <| pairs (tls())

testprm n (CIS hd tl as cs) =

if n < hd then CIS n <| \ () -> testprm (n + 2) cs

else testprm (n + 2) (tl())

oddprms() =

CIS 3 <| \ () -> testprm 5 <| cmpsts <| allmlts <| oddprms()

in CIS 2 <| \ () -> oddprms()

type alias Model = ( Int, String, String )

type Msg = Start Int | Done ( Int, Int )

cLIMIT : Int

cLIMIT = 1000000

timemillis : () -> Task Never Int

timemillis() = now |> andThen (\ t -> succeed (posixToMillis t))

test : Int -> Cmd Msg

test lmt =

let cnt = countCISTo lmt (primesTreeFolding()) -- (soeDict())

in timemillis() |> andThen (\ t -> succeed ( t, cnt )) |> perform Done

myupdate : Msg -> Model -> (Model, Cmd Msg)

myupdate msg mdl =

let (strttm, oldstr, _) = mdl in

case msg of

Start tm -> ( ( tm, oldstr, "Running..." ), test cLIMIT )

Done (stptm, answr) ->

( ( stptm, oldstr, "Found " ++ String.fromInt answr ++

" primes to " ++ String.fromInt cLIMIT ++

" in " ++ String.fromInt (stptm - strttm) ++ " milliseconds." )

, Cmd.none )

myview : Model -> Html msg

myview mdl =

let (_, str1, str2) = mdl

in div [] [ div [] [text str1], div [] [text str2] ]

main : Program () Model Msg

main =

element { init = \ _ -> ( ( 0

, "The primes up to 100 are: " ++

(primesTreeFolding() |> uptoCIS2List 100

|> List.map String.fromInt

|> String.join ", ") ++ "."

, "" ), perform Start (timemillis()) )

, update = myupdate

, subscriptions = \ _ -> Sub.none

, view = myview }</lang>

{{out}}

<pre>The primes up to 100 are: 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97.

Found 78498 primes to 1000000 in 295 milliseconds.</pre>

===Elm Priority Queue Version===

Using a Binary Minimum Heap Priority Queue is a constant factor faster than the above code as the data structure is balanced rather than "heavy to the right" in the following code, which implements enough of the Priority Queue for the purpose:

<lang elm>module Main exposing ( main )

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)

uptoCIS2List : comparable -> CIS comparable -> List comparable

uptoCIS2List n cis =

let loop (CIS hd tl) lst =

if hd > n then List.reverse lst

else loop (tl()) (hd :: lst)

in loop cis []

countCISTo : comparable -> CIS comparable -> Int

countCISTo lmt cis =

let cntem acc (CIS hd tlf) =

if hd > lmt then acc else cntem (acc + 1) (tlf())

in cntem 0 cis

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

primesPQ : () -> CIS Int

primesPQ() =

let

sieve n pq q (CIS bp bptl as bps) =

if n >= q then

let adv = bp + bp in let (CIS nbp _ as nbps) = bptl()

in sieve (n + 2) (pushPQ (q + adv) adv pq) (nbp * nbp) nbps

else let

(nxtc, _) = peekMinPQ pq |> Maybe.withDefault (q, 0) -- default when empty

adjust tpq =

let (c, adv) = peekMinPQ tpq |> Maybe.withDefault (0, 0)

in if c > n then tpq

else adjust (replaceMinPQ (c + adv) adv tpq)

in if n >= nxtc then sieve (n + 2) (adjust pq) q bps

else CIS n <| \ () -> sieve (n + 2) pq q bps

oddprms() = CIS 3 <| \ () -> sieve 5 emptyPQ 9 <| oddprms()

in CIS 2 <| \ () -> oddprms()

type alias Model = ( Int, String, String )

type Msg = Start Int | Done ( Int, Int )

timemillis : () -> Task Never Int

timemillis() = now |> andThen (\ t -> succeed (posixToMillis t))

test : Int -> Cmd Msg

test lmt =

let cnt = countCISTo lmt (primesPQ())

in timemillis() |> andThen (\ t -> succeed ( t, cnt )) |> perform Done

myupdate : Msg -> Model -> (Model, Cmd Msg)

myupdate msg mdl =

let (strttm, oldstr, _) = mdl in

case msg of

Start tm -> ( ( tm, oldstr, "Running..." ), test cLIMIT )

Done (stptm, answr) ->

( ( stptm, oldstr, "Found " ++ String.fromInt answr ++

" primes to " ++ String.fromInt cLIMIT ++

" in " ++ String.fromInt (stptm - strttm) ++ " milliseconds." )

, Cmd.none )

myview : Model -> Html msg

myview mdl =

let (_, str1, str2) = mdl

in div [] [ div [] [text str1], div [] [text str2] ]

main : Program () Model Msg

main =

element { init = \ _ -> ( ( 0

, "The primes up to 100 are: " ++

(primesPQ() |> uptoCIS2List 100

|> List.map String.fromInt

|> String.join ", ") ++ "."

, "" ), perform Start (timemillis()) )

, update = myupdate

, subscriptions = \ _ -> Sub.none

, view = myview }</lang>

{{out}}

<pre>The primes up to 100 are: 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97.

Found 78498 primes to 1000000 in 192 milliseconds.</pre>