Сито Эратосфена в F # - PullRequest
       68

Сито Эратосфена в F #

35 голосов
/ 07 января 2011

Меня интересует реализация сита эратосфена в чисто функциональной F #.Я заинтересован в реализации действительного сита, , а не наивной функциональной реализации, которая на самом деле не является ситом , поэтому не что-то вроде этого:

let rec PseudoSieve list =
    match list with
    | hd::tl -> hd :: (PseudoSieve <| List.filter (fun x -> x % hd <> 0) tl)
    | [] -> []

Вторая краткая ссылка вышеописывает алгоритм, который потребует использования мультикарты, которая, насколько я знаю, недоступна в F #.В данной реализации на Haskell используется карта, поддерживающая метод insertWith, который я не видел доступным на функциональной карте F # .

Кто-нибудь знает способ перевода данного Haskell?сопоставить код с F # или, возможно, знает об альтернативных методах реализации или алгоритмах просеивания, которые настолько же эффективны и лучше подходят для функциональной реализации, либо F #?

Ответы [ 14 ]

16 голосов
/ 08 января 2011

Читая эту статью, я пришел к мысли, что не требуется мультикарта. Он обрабатывает сталкивающиеся ключи карты, снова и снова перемещая сталкивающийся ключ вперед по его простому значению, пока не достигнет ключа, которого нет на карте. Ниже primes - карта с ключами следующего значения итератора и значениями, которые являются простыми числами.

let primes = 
    let rec nextPrime n p primes =
        if primes |> Map.containsKey n then
            nextPrime (n + p) p primes
        else
            primes.Add(n, p)

    let rec prime n primes =
        seq {
            if primes |> Map.containsKey n then
                let p = primes.Item n
                yield! prime (n + 1) (nextPrime (n + p) p (primes.Remove n))
            else
                yield n
                yield! prime (n + 1) (primes.Add(n * n, n))
        }

    prime 2 Map.empty

Вот алгоритм на основе очереди приоритетов из этой бумаги без оптимизации квадрата. Я поместил общие функции очереди приоритетов наверху. Я использовал кортеж для представления ленивых итераторов списка.

let primes() = 
    // the priority queue functions
    let insert = Heap.Insert
    let findMin = Heap.Min
    let insertDeleteMin = Heap.DeleteInsert

    // skips primes 2, 3, 5, 7
    let wheelData = [|2L;4L;2L;4L;6L;2L;6L;4L;2L;4L;6L;6L;2L;6L;4L;2L;6L;4L;6L;8L;4L;2L;4L;2L;4L;8L;6L;4L;6L;2L;4L;6L;2L;6L;6L;4L;2L;4L;6L;2L;6L;4L;2L;4L;2L;10L;2L;10L|]

    // increments iterator
    let wheel (composite, n, prime) =
        composite + wheelData.[n % 48] * prime, n + 1, prime

    let insertPrime prime n table =
        insert (prime * prime, n, prime) table

    let rec adjust x (table : Heap) =
        let composite, n, prime = findMin table

        if composite <= x then 
            table 
            |> insertDeleteMin (wheel (composite, n, prime))
            |> adjust x
        else
            table

    let rec sieve iterator table =
        seq {
            let x, n, _ = iterator
            let composite, _, _ = findMin table

            if composite <= x then
                yield! sieve (wheel iterator) (adjust x table)
            else
                if x = 13L then
                    yield! [2L; 3L; 5L; 7L; 11L]

                yield x
                yield! sieve (wheel iterator) (insertPrime x n table)
        }

    sieve (13L, 1, 1L) (insertPrime 11L 0 (Heap(0L, 0, 0L)))

Вот алгоритм на основе очереди приоритетов с квадратной оптимизацией. Чтобы облегчить ленивое добавление простых чисел в таблицу поиска, необходимо вернуть смещения колес вместе с простыми значениями. В этой версии алгоритма используется память O (sqrt (n)), где неоптимизированной является O (n).

let rec primes2() : seq<int64 * int> = 
    // the priority queue functions
    let insert = Heap.Insert
    let findMin = Heap.Min
    let insertDeleteMin = Heap.DeleteInsert

    // increments iterator
    let wheel (composite, n, prime) =
        composite + wheelData.[n % 48] * prime, n + 1, prime

    let insertPrime enumerator composite table =
        // lazy initialize the enumerator
        let enumerator =
            if enumerator = null then
                let enumerator = primes2().GetEnumerator()
                enumerator.MoveNext() |> ignore
                // skip primes that are a part of the wheel
                while fst enumerator.Current < 11L do
                    enumerator.MoveNext() |> ignore
                enumerator
            else
                enumerator

        let prime = fst enumerator.Current
        // Wait to insert primes until their square is less than the tables current min
        if prime * prime < composite then
            enumerator.MoveNext() |> ignore
            let prime, n = enumerator.Current
            enumerator, insert (prime * prime, n, prime) table
        else
            enumerator, table

    let rec adjust x table =
        let composite, n, prime = findMin table

        if composite <= x then 
            table 
            |> insertDeleteMin (wheel (composite, n, prime))
            |> adjust x
        else
            table

    let rec sieve iterator (enumerator, table) = 
        seq {
            let x, n, _ = iterator
            let composite, _, _ = findMin table

            if composite <= x then
                yield! sieve (wheel iterator) (enumerator, adjust x table)
            else
                if x = 13L then
                    yield! [2L, 0; 3L, 0; 5L, 0; 7L, 0; 11L, 0]

                yield x, n
                yield! sieve (wheel iterator) (insertPrime enumerator composite table)
        }

    sieve (13L, 1, 1L) (null, insert (11L * 11L, 0, 11L) (Heap(0L, 0, 0L)))

Вот моя тестовая программа.

type GenericHeap<'T when 'T : comparison>(defaultValue : 'T) =
    let mutable capacity = 1
    let mutable values = Array.create capacity defaultValue
    let mutable size = 0

    let swap i n =
        let temp = values.[i]
        values.[i] <- values.[n]
        values.[n] <- temp

    let rec rollUp i =
        if i > 0 then
            let parent = (i - 1) / 2
            if values.[i] < values.[parent] then
                swap i parent
                rollUp parent

    let rec rollDown i =
        let left, right = 2 * i + 1, 2 * i + 2

        if right < size then
            if values.[left] < values.[i] then
                if values.[left] < values.[right] then
                    swap left i
                    rollDown left
                else
                    swap right i
                    rollDown right
            elif values.[right] < values.[i] then
                swap right i
                rollDown right
        elif left < size then
            if values.[left] < values.[i] then
                swap left i

    member this.insert (value : 'T) =
        if size = capacity then
            capacity <- capacity * 2
            let newValues = Array.zeroCreate capacity
            for i in 0 .. size - 1 do
                newValues.[i] <- values.[i]
            values <- newValues

        values.[size] <- value
        size <- size + 1
        rollUp (size - 1)

    member this.delete () =
        values.[0] <- values.[size]
        size <- size - 1
        rollDown 0

    member this.deleteInsert (value : 'T) =
        values.[0] <- value
        rollDown 0

    member this.min () =
        values.[0]

    static member Insert (value : 'T) (heap : GenericHeap<'T>) =
        heap.insert value
        heap    

    static member DeleteInsert (value : 'T) (heap : GenericHeap<'T>) =
        heap.deleteInsert value
        heap    

    static member Min (heap : GenericHeap<'T>) =
        heap.min()

type Heap = GenericHeap<int64 * int * int64>

let wheelData = [|2L;4L;2L;4L;6L;2L;6L;4L;2L;4L;6L;6L;2L;6L;4L;2L;6L;4L;6L;8L;4L;2L;4L;2L;4L;8L;6L;4L;6L;2L;4L;6L;2L;6L;6L;4L;2L;4L;6L;2L;6L;4L;2L;4L;2L;10L;2L;10L|]

let primes() = 
    // the priority queue functions
    let insert = Heap.Insert
    let findMin = Heap.Min
    let insertDeleteMin = Heap.DeleteInsert

    // increments iterator
    let wheel (composite, n, prime) =
        composite + wheelData.[n % 48] * prime, n + 1, prime

    let insertPrime prime n table =
        insert (prime * prime, n, prime) table

    let rec adjust x (table : Heap) =
        let composite, n, prime = findMin table

        if composite <= x then 
            table 
            |> insertDeleteMin (wheel (composite, n, prime))
            |> adjust x
        else
            table

    let rec sieve iterator table =
        seq {
            let x, n, _ = iterator
            let composite, _, _ = findMin table

            if composite <= x then
                yield! sieve (wheel iterator) (adjust x table)
            else
                if x = 13L then
                    yield! [2L; 3L; 5L; 7L; 11L]

                yield x
                yield! sieve (wheel iterator) (insertPrime x n table)
        }

    sieve (13L, 1, 1L) (insertPrime 11L 0 (Heap(0L, 0, 0L)))

let rec primes2() : seq<int64 * int> = 
    // the priority queue functions
    let insert = Heap.Insert
    let findMin = Heap.Min
    let insertDeleteMin = Heap.DeleteInsert

    // increments iterator
    let wheel (composite, n, prime) =
        composite + wheelData.[n % 48] * prime, n + 1, prime

    let insertPrime enumerator composite table =
        // lazy initialize the enumerator
        let enumerator =
            if enumerator = null then
                let enumerator = primes2().GetEnumerator()
                enumerator.MoveNext() |> ignore
                // skip primes that are a part of the wheel
                while fst enumerator.Current < 11L do
                    enumerator.MoveNext() |> ignore
                enumerator
            else
                enumerator

        let prime = fst enumerator.Current
        // Wait to insert primes until their square is less than the tables current min
        if prime * prime < composite then
            enumerator.MoveNext() |> ignore
            let prime, n = enumerator.Current
            enumerator, insert (prime * prime, n, prime) table
        else
            enumerator, table

    let rec adjust x table =
        let composite, n, prime = findMin table

        if composite <= x then 
            table 
            |> insertDeleteMin (wheel (composite, n, prime))
            |> adjust x
        else
            table

    let rec sieve iterator (enumerator, table) = 
        seq {
            let x, n, _ = iterator
            let composite, _, _ = findMin table

            if composite <= x then
                yield! sieve (wheel iterator) (enumerator, adjust x table)
            else
                if x = 13L then
                    yield! [2L, 0; 3L, 0; 5L, 0; 7L, 0; 11L, 0]

                yield x, n
                yield! sieve (wheel iterator) (insertPrime enumerator composite table)
        }

    sieve (13L, 1, 1L) (null, insert (11L * 11L, 0, 11L) (Heap(0L, 0, 0L)))


let mutable i = 0

let compare a b =
    i <- i + 1
    if a = b then
        true
    else
        printfn "%A %A %A" a b i
        false

Seq.forall2 compare (Seq.take 50000 (primes())) (Seq.take 50000 (primes2() |> Seq.map fst))
|> printfn "%A"

primes2()
|> Seq.map fst
|> Seq.take 10
|> Seq.toArray
|> printfn "%A"

primes2()
|> Seq.map fst
|> Seq.skip 999999
|> Seq.take 10
|> Seq.toArray
|> printfn "%A"

System.Console.ReadLine() |> ignore
9 голосов
/ 26 сентября 2013

Хотя один ответ давал алгоритм, использующий Priority Queue (PQ) , как в SkewBinomialHeap , это, возможно, не правильный PQ дляработа.Для инкрементного сита эратосфена (iEoS) требуется PQ, обладающий превосходной производительностью для получения минимального значения и повторной вставки значений, в основном, чуть дальше по очереди, но не требует максимальной производительности для добавления новых значений, поскольку iSoE добавляет только как новыеоценивает общее количество простых чисел вплоть до квадратного корня из диапазона (что составляет крошечную долю от числа повторных вставок, которые происходят один раз за сокращение).SkewBinomialHeap PQ на самом деле не дает намного больше, чем использование встроенной карты, которая использует сбалансированное двоичное дерево поиска - все операции O (log n) - кроме того, что она слегка меняет вес операций вв пользу требований SoE.Однако SkewBinaryHeap по-прежнему требует много операций O (log n) для каждого сокращения.

PQ, реализованный как Heap , более конкретно, как Binary Heap и даже большев частности, MinHeap в значительной степени удовлетворяет требованиям iSoE с производительностью O (1) для получения минимальной производительности и производительности O (log n) для повторных вставок и добавления новых записей, хотя производительность на самом деле составляет долю O (log n), так как большинствоповторные вставки происходят в верхней части очереди, и большинство добавлений новых значений (которые не имеют значения, поскольку они встречаются редко) происходят в конце очереди, где эти операции наиболее эффективны.Кроме того, MinHeap PQ может эффективно реализовать минимум удаления и функцию вставки за один (как правило, часть) один O (log n) проход.Затем вместо карты (которая реализована в виде AVL-дерева ), где есть одна операция O (log n) с полным диапазоном 'log n' из-за минимального значения, которое нам требуется прина крайнем левом последнем листе дерева мы обычно добавляем и удаляем минимум в корне и вставляем в среднем несколько уровней вниз за один проход.Таким образом, MinHeap PQ может использоваться только с одной долей операции O (log n) на сокращение выборки, а не с несколькими операциями с большей долей O (log n).

MinHeap PQ может быть реализован с помощью чистого функционального кода (без «removeMin», реализованного, поскольку iSoE не требует этого, но есть функция «Adjust» для использования в сегментации), следующим образом:

[<RequireQualifiedAccess>]
module MinHeap =

  type MinHeapTreeEntry<'T> = class val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
  [<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
  [<NoEquality; NoComparison>]
  type MinHeapTree<'T> = 
      | HeapEmpty 
      | HeapOne of MinHeapTreeEntry<'T>
      | HeapNode of MinHeapTreeEntry<'T> * MinHeapTree<'T> * MinHeapTree<'T> * uint32

  let empty = HeapEmpty

  let getMin pq = match pq with | HeapOne(kv) | HeapNode(kv,_,_,_) -> Some kv | _ -> None

  let insert k v pq =
    let kv = MinHeapTreeEntry(k,v)
    let rec insert' kv msk pq =
      match pq with
        | HeapEmpty -> HeapOne kv
        | HeapOne kv2 -> if k < kv2.k then HeapNode(kv,pq,HeapEmpty,2u)
                          else let nn = HeapOne kv in HeapNode(kv2,nn,HeapEmpty,2u)
        | HeapNode(kv2,l,r,cnt) ->
          let nc = cnt + 1u
          let nmsk = if msk <> 0u then msk <<< 1
                     else let s = int32 (System.Math.Log (float nc) / System.Math.Log(2.0))
                          (nc <<< (32 - s)) ||| 1u //never ever zero again with the or'ed 1
          if k <= kv2.k then if (nmsk &&& 0x80000000u) = 0u then HeapNode(kv,insert' kv2 nmsk l,r,nc)
                                                            else HeapNode(kv,l,insert' kv2 nmsk r,nc)
          else if (nmsk &&& 0x80000000u) = 0u then HeapNode(kv2,insert' kv nmsk l,r,nc)
                else HeapNode(kv2,l,insert' kv nmsk r,nc)
    insert' kv 0u pq

  let private reheapify kv k pq =
    let rec reheapify' pq =
      match pq with
        | HeapEmpty -> HeapEmpty //should never be taken
        | HeapOne kvn -> HeapOne kv
        | HeapNode(kvn,l,r,cnt) ->
            match r with
              | HeapOne kvr when k > kvr.k ->
                  match l with //never HeapEmpty
                    | HeapOne kvl when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,HeapOne kv,cnt)
                        else HeapNode(kvl,HeapOne kv,r,cnt)
                    | HeapNode(kvl,_,_,_) when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,HeapOne kv,cnt)
                        else HeapNode(kvl,reheapify' l,r,cnt)
                    | _ -> HeapNode(kvr,l,HeapOne kv,cnt) //only right qualifies
              | HeapNode(kvr,_,_,_) when k > kvr.k -> //need adjusting for left leaf or else left leaf
                  match l with //never HeapEmpty or HeapOne
                    | HeapNode(kvl,_,_,_) when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,reheapify' r,cnt)
                        else HeapNode(kvl,reheapify' l,r,cnt)
                    | _ -> HeapNode(kvr,l,reheapify' r,cnt) //only right qualifies
              | _ -> match l with //r could be HeapEmpty but l never HeapEmpty
                        | HeapOne(kvl) when k > kvl.k -> HeapNode(kvl,HeapOne kv,r,cnt)
                        | HeapNode(kvl,_,_,_) when k > kvl.k -> HeapNode(kvl,reheapify' l,r,cnt)
                        | _ -> HeapNode(kv,l,r,cnt) //just replace the contents of pq node with sub leaves the same
    reheapify' pq


  let reinsertMinAs k v pq =
    let kv = MinHeapTreeEntry(k,v)
    reheapify kv k pq

  let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then rebuild by reheapify
    let rec adjust' pq =
      match pq with
        | HeapEmpty -> pq
        | HeapOne kv -> HeapOne(MinHeapTreeEntry(f kv.k kv.v))
        | HeapNode (kv,l,r,cnt) -> let nkv = MinHeapTreeEntry(f kv.k kv.v)
                                   reheapify nkv nkv.k (HeapNode(kv,adjust' l,adjust' r,cnt))
    adjust' pq

Используя вышеупомянутый модуль, iSoE можно записатьс оптимизацией факторизации колеса и использованием эффективных коиндуктивных потоков (CIS) следующим образом:

type CIS<'T> = class val v:'T val cont:unit->CIS<'T> new(v,cont) = { v=v;cont=cont } end
type cullstate = struct val p:uint32 val wi:int new(cnd,cndwi) = { p=cnd;wi=cndwi } end
let primesPQWSE() =
  let WHLPRMS = [| 2u;3u;5u;7u |] in let FSTPRM = 11u in let WHLCRC = int (WHLPRMS |> Seq.fold (*) 1u) >>> 1
  let WHLLMT = int (WHLPRMS |> Seq.fold (fun o n->o*(n-1u)) 1u) - 1
  let WHLPTRN =
    let wp = Array.zeroCreate (WHLLMT+1)
    let gaps (a:int[]) = let rec gap i acc = if a.[i]=0 then gap (i+1) (acc+1uy) else acc
                         {0..WHLCRC-1} |> Seq.fold (fun s i->
                           let ns = if a.[i]<>0 then wp.[s]<-2uy*gap (i+1) 1uy;(s+1) else s in ns) 0 |> ignore
    Array.init (WHLCRC+1) (fun i->if WHLPRMS |> Seq.forall (fun p->(FSTPRM+uint32(i<<<1))%p<>0u)
                                  then 1 else 0) |> gaps;wp
  let inline whladv i = if i < WHLLMT then i + 1 else 0 in let advcnd c i = c + uint32 WHLPTRN.[i]
  let inline culladv c p i = let n = c + uint32 WHLPTRN.[i] * p in if n < c then 0xFFFFFFFFu else n
  let rec mkprm (n,wi,pq,(bps:CIS<_>),q) =
    let nxt = advcnd n wi in let nxti = whladv wi
    if nxt < n then (0u,0,(0xFFFFFFFFu,0,MinHeap.empty,bps,q))
    elif n>=q then let bp,bpi = bps.v in let nc,nci = culladv n bp bpi,whladv bpi
                    let nsd = bps.cont() in let np,_ = nsd.v in let sqr = if np>65535u then 0xFFFFFFFFu else np*np
                    mkprm (nxt,nxti,(MinHeap.insert nc (cullstate(bp,nci)) pq),nsd,sqr)
    else match MinHeap.getMin pq with | None -> (n,wi,(nxt,nxti,pq,bps,q))
                                      | Some kv -> let ca,cs = culladv kv.k kv.v.p kv.v.wi,cullstate(kv.v.p,whladv kv.v.wi)
                                                   if n>kv.k then mkprm (n,wi,(MinHeap.reinsertMinAs ca cs pq),bps,q)
                                                   elif n=kv.k then mkprm (nxt,nxti,(MinHeap.reinsertMinAs ca cs pq),bps,q)
                                                   else (n,wi,(nxt,nxti,pq,bps,q))
  let rec pCID p pi pq bps q = CIS((p,pi),fun()->let (np,npi,(nxt,nxti,npq,nbps,nq))=mkprm (advcnd p pi,whladv pi,pq,bps,q)
                                                 pCID np npi npq nbps nq)
  let rec baseprimes() = CIS((FSTPRM,0),fun()->let np=FSTPRM+uint32 WHLPTRN.[0]
                                               pCID np (whladv 0) MinHeap.empty (baseprimes()) (FSTPRM*FSTPRM))
  let genseq sd = Seq.unfold (fun (p,pi,pcc) ->if p=0u then None else Some(p,mkprm pcc)) sd
  seq { yield! WHLPRMS; yield! mkprm (FSTPRM,0,MinHeap.empty,baseprimes(),(FSTPRM*FSTPRM)) |> genseq }

Приведенный выше код вычисляет первые 100 000 простых чисел примерно за 0,077 секунды, первые 1 000 000 простых чисел за 0,977 секунды, первое10 000 000 простых чисел за 14,33 секунды и первые 100 000 000 простых чисел за 221,87 секунды, все на i7-2700K (3,5 ГГц) в виде 64-битного кода.Этот чисто функциональный код немного быстрее, чем код изменчивого кода на основе словаря Дастина Камбелла с добавленной общей оптимизацией факторизации колес, отложенным добавлением базовых простых чисел и использованием всех более эффективных CID (tryfsharp и ideone ) , но все еще является чисто функциональным кодом, в котором он использует класс Dictionary не .Однако для больших диапазонов простых чисел, составляющих около двух миллиардов (около 100 миллионов простых), код, использующий словарь на основе хеш-таблицы, будет работать быстрее, поскольку операции словаря не имеют коэффициента O (log n), и этот выигрыш преодолевает вычислительныйсложность использования словарных хеш-таблиц.

Вышеуказанная программа имеет еще одну особенность, заключающуюся в том, что колесо факторизации параметризовано так, что, например, можно использовать очень большое колесо, установив WHLPRMS в [| 2u; 3u; 5u; 7u; 11u; 13u; 17u; 19u |] и FSTPRM до 23u, чтобы получить время выполнения около двух третей для больших диапазонов при 9,34 секунды для десяти миллионов простых чисел, хотя следует учесть, что для этого требуется несколько секунд вычислите WHLPTRN до запуска программы, что является постоянным расходом независимо от простого диапазона.

Сравнительный анализ : По сравнению с чисто функциональной реализацией пошагового сворачивания дерева этот алгоритм немного быстрее, потому что средняя используемая высота дерева MinHeap меньше в два раза, чем глубина сложенное дерево, но это компенсируется эквивалентной постоянной потерей коэффициента эффективности в способности обходить уровни дерева PQ, поскольку оно основано на двоичной куче, требующей обработки как правого, так и левого листьев для каждого уровня кучи и ветви, так или иначе чем одно сравнение на уровень для свертывания дерева с обычно менее глубокой ветвью, чем взятая. По сравнению с другими функциональными алгоритмами, основанными на PQ и карте, улучшения, как правило, являются постоянным фактором сокращения числа операций O (log n) при обходе каждого уровня соответствующих древовидных структур.

MinHeap обычно реализуется как изменяемый массив двоичная куча после модели на основе генеалогического дерева, изобретенной Майклом Эйтцингером более 400 лет назад. Я знаю, что вопрос сказал, что не интересен нефункциональный изменяемый код, но если нужно избегать всех вложенных кодов, которые используют изменчивость, то мы не могли бы использовать списки или LazyList, которые используют изменчивость «под прикрытием» из соображений производительности. Итак, представьте, что следующая альтернативная изменяемая версия MinHeap PQ предоставлена ​​библиотекой и имеет еще один коэффициент более двух для больших простых диапазонов производительности:

[<RequireQualifiedAccess>]
module MinHeap =

  type MinHeapTreeEntry<'T> = class val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
  type MinHeapTree<'T> = ResizeArray<MinHeapTreeEntry<'T>>

  let empty<'T> = MinHeapTree<MinHeapTreeEntry<'T>>()

  let getMin (pq:MinHeapTree<_>) = if pq.Count > 0 then Some pq.[0] else None

  let insert k v (pq:MinHeapTree<_>) =
    if pq.Count = 0 then pq.Add(MinHeapTreeEntry(0xFFFFFFFFu,v)) //add an extra entry so there's always a right max node
    let mutable nxtlvl = pq.Count in let mutable lvl = nxtlvl <<< 1 //1 past index of value added times 2
    pq.Add(pq.[nxtlvl - 1]) //copy bottom entry then do bubble up while less than next level up
    while ((lvl <- lvl >>> 1); nxtlvl <- nxtlvl >>> 1; nxtlvl <> 0) do
      let t = pq.[nxtlvl - 1] in if t.k > k then pq.[lvl - 1] <- t else lvl <- lvl <<< 1; nxtlvl <- 0 //causes loop break
    pq.[lvl - 1] <-  MinHeapTreeEntry(k,v); pq

  let reinsertMinAs k v (pq:MinHeapTree<_>) = //do minify down for value to insert
    let mutable nxtlvl = 1 in let mutable lvl = nxtlvl in let cnt = pq.Count
    while (nxtlvl <- nxtlvl <<< 1; nxtlvl < cnt) do
      let lk = pq.[nxtlvl - 1].k in let rk = pq.[nxtlvl].k in let oldlvl = lvl
      let k = if k > lk then lvl <- nxtlvl; lk else k in if k > rk then nxtlvl <- nxtlvl + 1; lvl <- nxtlvl
      if lvl <> oldlvl then pq.[oldlvl - 1] <- pq.[lvl - 1] else nxtlvl <- cnt //causes loop break
    pq.[lvl - 1] <- MinHeapTreeEntry(k,v); pq

  let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then re-heapify
    if pq <> null then 
      let cnt = pq.Count
      if cnt > 1 then
        for i = 0 to cnt - 2 do //change contents using function
          let e = pq.[i] in let k,v = e.k,e.v in pq.[i] <- MinHeapTreeEntry (f k v)
        for i = cnt/2 downto 1 do //rebuild by reheapify
          let kv = pq.[i - 1] in let k = kv.k
          let mutable nxtlvl = i in let mutable lvl = nxtlvl
          while (nxtlvl <- nxtlvl <<< 1; nxtlvl < cnt) do
            let lk = pq.[nxtlvl - 1].k in let rk = pq.[nxtlvl].k in let oldlvl = lvl
            let k = if k > lk then lvl <- nxtlvl; lk else k in if k > rk then nxtlvl <- nxtlvl + 1; lvl <- nxtlvl
            if lvl <> oldlvl then pq.[oldlvl - 1] <- pq.[lvl - 1] else nxtlvl <- cnt //causes loop break
          pq.[lvl - 1] <- kv
    pq

Замечание Geek: на самом деле я ожидал, что изменяемая версия предложит намного лучшее улучшенное соотношение производительности, но она затормозится при повторных вставках из-за вложенной структуры кода if-then-else и случайного поведения основной выборки значения означают, что предсказание ветвления ЦП не выполняется для большой части ветвей, что приводит к множеству дополнительных 10-ти тактовых циклов ЦП на единицу сокращения для восстановления кеша предварительной выборки команд.

Единственным другим приростом производительности с постоянным коэффициентом по этому алгоритму будет сегментирование и использование многозадачности для увеличения производительности, пропорционального количеству ядер ЦП; однако, в его нынешнем виде, это самый быстрый чисто функциональный алгоритм SoE на сегодняшний день, и даже чистая функциональная форма с использованием функционала MinHeap превосходит упрощенные императивные реализации, такие как код Джона Харропа или сито Йохана Кульбома Аткин (что является ошибкой в ​​его времени, так как он вычислил только простых чисел до 10 миллионов, а не 10 миллионовных простых ), но эти алгоритмы были бы примерно в пять раз быстрее, если бы использовались лучшие оптимизации. Это соотношение около пяти между функциональным и императивным кодом будет несколько уменьшено, когда мы добавим многопоточность с большей факторизацией колеса, так как вычислительная сложность императивного кода увеличивается быстрее, чем функциональный код, а многопоточность помогает более медленному функциональному коду больше, чем более быстрый императивный код, поскольку последний приближается к базовому пределу времени, необходимого для перечисления через найденные простые числа.

EDIT_ADD: Несмотря на то, что можно было бы продолжать использовать чисто функциональную версию MinHeap, добавление эффективной сегментации при подготовке к многопоточности немного «сломало бы» чистоту «функционального кода следующим образом: 1) Наиболее эффективный способ передачи представления составных отбракованных чисел - это массив упакованных битов размером сегмента, 2) хотя размер массива известен с использованием понимания массива функционально инициализировать его неэффективно, так как он использует «ResizeArray» под крышками, который должен копировать себя для каждого добавления x (я думаю, «x» - восемь для текущей реализации), а использование Array.init не работать так, как пропускаются многие значения по определенным индексам, 3) Следовательно, самый простой способ заполнить составной массив - это обнулить его, создать правильный размер и затем запустить функцию инициализации, которая может записывать в каждый индекс изменяемого массива не более одного раза , Хотя это не является строго «функциональным», оно близко к тому, что массив инициализируется, а затем никогда не изменяется снова.

Код с добавленной сегментацией, многопоточностью, программируемой факториальной окружностью колес и многими настройками производительности выглядит следующим образом (кроме некоторых добавленных новых констант, дополнительный настроенный код для реализации сегментации и многопоточности составляет примерно половину кода, начинающегося с функции "prmspg"):

type prmsCIS = class val pg:uint16 val bg:uint16 val pi:int val cont:unit->prmsCIS
                     new(pg,bg,pi,nxtprmf) = { pg=pg;bg=bg;pi=pi;cont=nxtprmf } end
type cullstate = struct val p:uint32 val wi:int new(cnd,cndwi) = { p=cnd;wi=cndwi } end
let primesPQOWSE() =
  let WHLPRMS = [| 2u;3u;5u;7u;11u;13u;17u |] in let FSTPRM = 19u in let WHLCRC = int(WHLPRMS |> Seq.fold (*) 1u)
  let MXSTP = uint64(FSTPRM-1u) in let BFSZ = 1<<<11 in let NUMPRCS = System.Environment.ProcessorCount
  let WHLLMT = int (WHLPRMS |> Seq.fold (fun o n->o*(n-1u)) 1u) - 1 in let WHLPTRN = Array.zeroCreate (WHLLMT+1)
  let WHLRNDUP = let gaps (a:int[]) = let rec gap i acc = if a.[i]=0 then gap (i+1) (acc+1)
                                                          else acc in let b = a |> Array.scan (+) 0
                                      Array.init (WHLCRC>>>1) (fun i->
                                        if a.[i]=0 then 0 else let g=2*gap (i+1) 1 in WHLPTRN.[b.[i]]<-byte g;1)
                 Array.init WHLCRC (fun i->if WHLPRMS |> Seq.forall (fun p->(FSTPRM+uint32(i<<<1))%p<>0u) then 1 else 0)
                 |> gaps |> Array.scan (+) 0
  let WHLPOS = WHLPTRN |> Array.map (uint32) |> Array.scan (+) 0u in let advcnd cnd cndi = cnd + uint32 WHLPTRN.[cndi]
  let MINRNGSTP = if WHLLMT<=31 then uint32(32/(WHLLMT+1)*WHLCRC) else if WHLLMT=47 then uint32 WHLCRC<<<1 else uint32 WHLCRC
  let MINBFRNG = uint32((BFSZ<<<3)/(WHLLMT+1)*WHLCRC)/MINRNGSTP*MINRNGSTP
  let MINBFRNG = if MINBFRNG=0u then MINRNGSTP else MINBFRNG
  let inline whladv i = if i < WHLLMT then i+1 else 0 in let inline culladv c p i = c+uint32 WHLPTRN.[i]*p
  let rec mkprm (n,wi,pq,(bps:prmsCIS),q,lstp,bgap) =
    let nxt,nxti = advcnd n wi,whladv wi
    if n>=q then let p = (uint32 bps.bg<<<16)+uint32 bps.pg
                 let nbps,nxtcmpst,npi = bps.cont(),culladv n p bps.pi,whladv bps.pi
                 let pg = uint32 nbps.pg in let np = p+pg in let sqr = q+pg*((p<<<1)+pg) //only works to p < about 13 million
                 let nbps = prmsCIS(uint16 np,uint16(np>>>16),nbps.pi,nbps.cont) //therefore, algorithm only works to p^2 or about
                 mkprm (nxt,nxti,(MinHeap.insert nxtcmpst (cullstate(p,npi)) pq),nbps,sqr,lstp,(bgap+1us)) //1.7 * 10^14
    else match MinHeap.getMin pq with 
           | None -> (uint16(n-uint32 lstp),bgap,wi,(nxt,nxti,pq,bps,q,n,1us)) //fix with q is uint64
           | Some kv -> let ca,cs = culladv kv.k kv.v.p kv.v.wi,cullstate(kv.v.p,whladv kv.v.wi)
                        if n>kv.k then mkprm (n,wi,(MinHeap.reinsertMinAs ca cs pq),bps,q,lstp,bgap)
                        elif n=kv.k then mkprm (nxt,nxti,(MinHeap.reinsertMinAs ca cs pq),bps,q,lstp,(bgap+1us))
                        else (uint16(n-uint32 lstp),bgap,wi,(nxt,nxti,pq,bps,q,n,1us))
  let rec pCIS p pg bg pi pq bps q = prmsCIS(pg,bg,pi,fun()->
    let (npg,nbg,npi,(nxt,nxti,npq,nbps,nq,nl,ng))=mkprm (p+uint32 WHLPTRN.[pi],whladv pi,pq,bps,q,p,0us)
    pCIS (p+uint32 npg) npg nbg npi npq nbps nq)
  let rec baseprimes() = prmsCIS(uint16 FSTPRM,0us,0,fun()->
                           let np,npi=advcnd FSTPRM 0,whladv 0
                           pCIS np (uint16 WHLPTRN.[0]) 1us npi MinHeap.empty (baseprimes()) (FSTPRM*FSTPRM))
  let prmspg nxt adj pq bp q =
    //compute next buffer size rounded up to next even wheel circle so at least one each base prime hits the page
    let rng = max (((uint32(MXSTP+uint64(sqrt (float (MXSTP*(MXSTP+4UL*nxt))))+1UL)>>>1)+MINRNGSTP)/MINRNGSTP*MINRNGSTP) MINBFRNG
    let nxtp() = async {
      let rec addprms pqx (bpx:prmsCIS) qx = 
        if qx>=adj then pqx,bpx,qx //add primes to queue for new lower limit
        else let p = (uint32 bpx.bg<<<16)+uint32 bpx.pg in let nbps = bpx.cont()
             let pg = uint32 nbps.pg in let np = p+pg in let sqr = qx+pg*((p<<<1)+pg)
             let nbps = prmsCIS(uint16 np,uint16(np>>>16),nbps.pi,nbps.cont)
             addprms (MinHeap.insert qx (cullstate(p,bpx.pi)) pqx) nbps sqr
      let adjcinpg low k (v:cullstate) = //adjust the cull states for the new page low value
        let p = v.p in let WHLSPN = int64 WHLCRC*int64 p in let db = int64 p*int64 WHLPOS.[v.wi]
        let db = if k<low then let nk = int64(low-k)+db in nk-((nk/WHLSPN)*WHLSPN)
                 else let nk = int64(k-low) in if db<nk then db+WHLSPN-nk else db-nk
        let r = WHLRNDUP.[int((((db>>>1)%(WHLSPN>>>1))+int64 p-1L)/int64 p)] in let x = int64 WHLPOS.[r]*int64 p
        let r = if r>WHLLMT then 0 else r in let x = if x<db then x+WHLSPN-db else x-db in uint32 x,cullstate(p,r)
      let bfbtsz = int rng/WHLCRC*(WHLLMT+1) in let nbuf = Array.zeroCreate (bfbtsz>>>5)
      let rec nxtp' wi cnt = let _,nbg,_,ncnt = mkprm cnt in let nwi = wi + int nbg
                             if nwi < bfbtsz then nbuf.[nwi>>>5] <- nbuf.[nwi>>>5] ||| (1u<<<(nwi&&&0x1F)); nxtp' nwi ncnt
                             else let _,_,pq,bp,q,_,_ = ncnt in nbuf,pq,bp,q //results incl buf and cont parms for next page
      let npq,nbp,nq = addprms pq bp q
      return nxtp' 0 (0u,0,MinHeap.adjust (adjcinpg adj) npq,nbp,nq-adj,0u,0us) }
    rng,nxtp() |> Async.StartAsTask
  let nxtpg nxt (cont:(_*System.Threading.Tasks.Task<_>)[]) = //(len,pq,bp,q) =
    let adj = (cont |> Seq.fold (fun s (r,_)  -> s+r) 0u)
    let _,tsk = cont.[0] in let _,pq,bp,q = tsk.Result
    let ncont = Array.init (NUMPRCS+1) (fun i -> if i<NUMPRCS then cont.[i+1]
                                                 else prmspg (nxt+uint64 adj) adj pq bp q)
    let _,tsk = ncont.[0] in let nbuf,_,_,_ = tsk.Result in nbuf,ncont
  //init cond buf[0], no queue, frst bp sqr offset
  let initcond = 0u,System.Threading.Tasks.Task.Factory.StartNew (fun()->
                   (Array.empty,MinHeap.empty,baseprimes(),FSTPRM*FSTPRM-FSTPRM))
  let nxtcond n = prmspg (uint64 n) (n-FSTPRM) MinHeap.empty (baseprimes()) (FSTPRM*FSTPRM-FSTPRM)
  let initcont = Seq.unfold (fun (n,((r,_)as v))->Some(v,(n+r,nxtcond (n+r)))) (FSTPRM,initcond)
                 |> Seq.take (NUMPRCS+1) |> Seq.toArray
  let rec nxtprm (c,ci,i,buf:uint32[],cont) =
    let rec nxtprm' c ci i =
      let nc = c + uint64 WHLPTRN.[ci] in let nci = whladv ci in let ni = i + 1 in let nw = ni>>>5
      if nw >= buf.Length then let (npg,ncont)=nxtpg nc cont in nxtprm (c,ci,-1,npg,ncont)
      elif (buf.[nw] &&& (1u <<< (ni &&& 0x1F))) = 0u then nxtprm' nc nci ni
      else nc,nci,ni,buf,cont
    nxtprm' c ci i
  seq { yield! WHLPRMS |> Seq.map (uint64);
        yield! Seq.unfold (fun ((c,_,_,_,_) as cont)->Some(c,nxtprm cont))
                 (nxtprm (uint64 FSTPRM-uint64 WHLPTRN.[WHLLMT],WHLLMT,-1,Array.empty,initcont)) }

Обратите внимание, что в модулях MinHeap, как функциональных, так и основанных на массивах, была добавлена ​​функция «Adjust», позволяющая регулировать состояние отбраковки версии PQ каждого потока в начале каждой новой страницы сегмента. Также обратите внимание, что было возможно настроить код так, чтобы большая часть вычислений выполнялась с использованием 32-битных диапазонов с конечной последовательностью, выводимой как uint64, с небольшими затратами времени вычислений, так что в настоящее время теоретический диапазон составляет что-то более 100 триллионов (десять повышено до четырнадцатая степень), если кто-то готов подождать около трех-четырех месяцев, необходимых для вычисления этого диапазона. Проверки числового диапазона были удалены, поскольку маловероятно, чтобы кто-либо использовал этот алгоритм для вычисления этого диапазона, не говоря уже о его пропуске.

Используя чистый функционал MinHeap и факторизацию колес 2,3,5,7, вышеуказанная программа вычисляет первые сто тысяч, миллион, десять миллионов и сто миллионов простых чисел за 0,062, 0,629, 10,53 и 195,62 секунды, соответственно. Использование MinHeap на основе массива ускоряет это до 0,097, 0,276, 3,48 и 51,60 секунд соответственно. Использование колеса 2,3,5,7,11,13,17 путем изменения WHLPRMS на «[| 2u; 3u; 5u; 7u; 11u; 13u; 17u |]» и FSTPRM до 19u ускоряет эту скорость еще больше до 0,181, 0,308, 2,49 и 36,58 секунд соответственно (для постоянного улучшения коэффициента при постоянных издержках). Эта самая быстрая настройка вычисляет 203 280 221 простых чисел в диапазоне 32-разрядных чисел за 88,37 секунды. Константа «BFSZ» может быть скорректирована с помощью компромиссов между более медленным временем для версии с меньшими диапазонами и более быстрым временем для больших диапазонов, при этом значение «1 <<< 14» рекомендуется использовать для больших диапазонов. Эта константа устанавливает только минимальный размер буфера, при этом программа автоматически настраивает размер буфера выше этого размера для больших диапазонов, чтобы буфер был достаточным для того, чтобы наибольшее базовое простое число, требуемое для диапазона страниц, всегда "ударяло" по каждой странице хотя бы один раз ; это означает, что сложность и дополнительные затраты на дополнительное «сито ведра» не требуются. Эта последняя полностью оптимизированная версия может вычислять простые числа до 10 и 100 миллиардов примерно за 256,8 и 3617,4 секунды (чуть более часа для 100 миллиардов), как было протестировано с использованием "primesPQOWSE () |> Seq.takeWhile ((> =) 100000000000UL) |> Seq.fold (fun sp -> s + 1UL) 0UL "для вывода. Вот откуда берутся примерно полдня для подсчета простых чисел до триллиона, неделя для десяти триллионов и от трех до четырех месяцев для ста триллионов.

Я не думаю, что возможно сделать функциональный или почти функциональный код, используя инкрементный алгоритм SoE, чтобы работать намного быстрее, чем этот.Как видно из кода, оптимизация базового алгоритма приращения значительно увеличила сложность кода, так что он, вероятно, немного сложнее, чем эквивалентно оптимизированный код, основанный на отбраковке прямого массива, причем этот код способен работать примерно в десять раз быстрее, чемэто и без дополнительного показателя в производительности, означающего, что этот функциональный инкрементный код имеет постоянно увеличивающиеся дополнительные процентные издержки.

Так полезно ли это, кроме как с интересной теоретической и интеллектуальной точки зрения?Вероятно, это не так.Для меньших диапазонов простых чисел, примерно до десяти миллионов, лучшие из базовых не полностью оптимизированных инкрементальных функциональных SoE, вероятно, являются адекватными и довольно простыми для записи или имеют меньше использования оперативной памяти, чем самые простые императивные SoE.Однако они намного медленнее, чем более императивный код, использующий массив, поэтому они «выдыхаются» для диапазонов выше этого.Несмотря на то, что здесь было продемонстрировано, что код может быть ускорен за счет оптимизации, он все еще в 10 раз медленнее, чем более императивная версия на основе чистого массива, но добавляет сложности, по крайней мере, такой же сложной, как этот код с эквивалентными оптимизациями.и даже этот код под F # в DotNet примерно в четыре раза медленнее, чем при использовании языка, такого как C ++, скомпилированного непосредственно в нативный код;если бы кто-то действительно хотел исследовать большие диапазоны простых чисел, он, вероятно, использовал бы один из тех других языков и методов, где primesieve может вычислить число простых чисел в диапазоне сто триллионов менее чем за четыре часа вместо примерно трехмесяцев, необходимых для этого кода. END_EDIT_ADD

6 голосов
/ 01 июля 2013

Здесь в значительной степени максимально оптимизирован алгоритм алгоритма инкрементального (и рекурсивного) отображения на основе сита Эратосфена с использованием последовательностей, поскольку нет необходимости запоминать предыдущие значения последовательности (кроме небольшого преимущества для кэширования базовых простых значений).с использованием Seq.cache), при этом основные оптимизации заключаются в том, что он использует факторизацию колес для входной последовательности и использует несколько (рекурсивных) потоков для поддержания базовых простых чисел, которые меньше квадратного корня из последнего просеиваемого числа, следующим образом:

  let primesMPWSE =
    let whlptrn = [| 2;4;2;4;6;2;6;4;2;4;6;6;2;6;4;2;6;4;6;8;4;2;4;2;
                     4;8;6;4;6;2;4;6;2;6;6;4;2;4;6;2;6;4;2;4;2;10;2;10 |]
    let adv i = if i < 47 then i + 1 else 0
    let reinsert oldcmpst mp (prime,pi) =
      let cmpst = oldcmpst + whlptrn.[pi] * prime
      match Map.tryFind cmpst mp with
        | None -> mp |> Map.add cmpst [(prime,adv pi)]
        | Some(facts) -> mp |> Map.add cmpst ((prime,adv pi)::facts)
    let rec mkprimes (n,i) m ps q =
      let nxt = n + whlptrn.[i]
      match Map.tryFind n m with
        | None -> if n < q then seq { yield (n,i); yield! mkprimes (nxt,adv i) m ps q }
                  else let (np,npi),nlst = Seq.head ps,ps |> Seq.skip 1
                       let (nhd,ni),nxtcmpst = Seq.head nlst,n + whlptrn.[npi] * np
                       mkprimes (nxt,adv i) (Map.add nxtcmpst [(np,adv npi)] m) nlst (nhd * nhd)
        | Some(skips) -> let adjmap = skips |> List.fold (reinsert n) (m |> Map.remove n)
                         mkprimes (nxt,adv i) adjmap ps q
    let rec prs = seq {yield (11,0); yield! mkprimes (13,1) Map.empty prs 121 } |> Seq.cache
    seq { yield 2; yield 3; yield 5; yield 7; yield! mkprimes (11,0) Map.empty prs 121 |> Seq.map (fun (p,i) -> p) }

Он находит 100 000-е простые числа до 1 299 721 примерно за 0,445 секунды, но не является надлежащим императивным алгоритмом EoS, он не масштабируется почти линейно с увеличением числа простых чисел, для этого требуется 7,775 секундынайдите 1 000 000 простых чисел до 15 485 867 для производительности в этом диапазоне около 0 (n ^ 1.2), где n - это максимальное найденное простое число.

Существует немного больше настроек, которые можно выполнить, но, вероятно, это не так.не собираюсь делать мукиh разницы в большом проценте лучшей производительности следующим образом:

  1. Поскольку библиотека последовательностей F # заметно медленная, можно использовать самостоятельно определенный тип, который реализует IEnumerable, чтобы сократить времятратится во внутренней последовательности, но поскольку операции последовательности занимают всего около 20% от общего времени, даже если они были сокращены до нуля, результатом будет сокращение только до 80% времени.

  2. Можно использовать другие формы хранения карт, такие как очередь с приоритетами, упомянутая О'Нилом, или SkewBinomialHeap, используемый @gradbot, но, по крайней мере, для SkewBinomialHeap, улучшение производительности составляет всего несколько процентов.Похоже, что при выборе различных реализаций карты, просто торгуйте лучшим ответом при поиске и удалении элементов, которые находятся в начале списка, против времени, потраченного на вставку новых записей, чтобы воспользоваться этими преимуществами, чтобы чистый выигрыш был в значительной степени промывкой.и по-прежнему имеет производительность O (log n) с увеличением записей на карте.Вышеуказанная оптимизация с использованием нескольких потоков записей только до квадратного корня уменьшает количество записей на карте и, таким образом, делает эти улучшения не столь важными.

EDIT_ADD: Я выполнил небольшую дополнительную оптимизацию, и производительность улучшилась несколько больше, чем ожидалось, вероятно, из-за улучшенного способа устранения Seq.skip как способа продвижения по последовательности базовых простых чисел.Эта оптимизация использует замену для генерации внутренней последовательности как кортеж целочисленного значения и функцию продолжения, используемую для перехода к следующему значению в последовательности, с окончательной последовательностью F #, сгенерированной общей операцией раскрытия.Код выглядит следующим образом:

type SeqDesc<'a> = SeqDesc of 'a * (unit -> SeqDesc<'a>) //a self referring tuple type
let primesMPWSE =
  let whlptrn = [| 2;4;2;4;6;2;6;4;2;4;6;6;2;6;4;2;6;4;6;8;4;2;4;2;
                   4;8;6;4;6;2;4;6;2;6;6;4;2;4;6;2;6;4;2;4;2;10;2;10 |]
  let inline adv i = if i < 47 then i + 1 else 0
  let reinsert oldcmpst mp (prime,pi) =
    let cmpst = oldcmpst + whlptrn.[pi] * prime
    match Map.tryFind cmpst mp with
      | None -> mp |> Map.add cmpst [(prime,adv pi)]
      | Some(facts) -> mp |> Map.add cmpst ((prime,adv pi)::facts)
  let rec mkprimes (n,i) m (SeqDesc((np,npi),nsdf) as psd) q =
    let nxt = n + whlptrn.[i]
    match Map.tryFind n m with
      | None -> if n < q then SeqDesc((n,i),fun() -> mkprimes (nxt,adv i) m psd q)
                else let (SeqDesc((nhd,x),ntl) as nsd),nxtcmpst = nsdf(),n + whlptrn.[npi] * np
                     mkprimes (nxt,adv i) (Map.add nxtcmpst [(np,adv npi)] m) nsd (nhd * nhd)
      | Some(skips) -> let adjdmap = skips |> List.fold (reinsert n) (m |> Map.remove n)
                       mkprimes (nxt,adv i) adjdmap psd q
  let rec prs = SeqDesc((11,0),fun() -> mkprimes (13,1) Map.empty prs 121 )
  let genseq sd = Seq.unfold (fun (SeqDesc((n,i),tailfunc)) -> Some(n,tailfunc())) sd
  seq { yield 2; yield 3; yield 5; yield 7; yield! mkprimes (11,0) Map.empty prs 121 |> genseq }

Время, необходимое для нахождения 100 000-го и 1 000 000-го простых чисел, составляет около 0,31 и 5,1 секунды соответственно, поэтому при этом небольшом изменении наблюдается значительный выигрыш в процентах.Я попробовал свою собственную реализацию интерфейсов IEnumerable / IEnumerator, которые являются основой последовательностей, и, хотя они работают быстрее, чем версии, используемые модулем Seq, они едва ли имеют какое-либо дальнейшее отличие от этого алгоритма, где большая часть времени проводится вФункции карты. END_EDIT_ADD

Кроме инкрементных реализаций EoS на основе карт, существует другая «чисто функциональная» реализация, использующая Tree Folding, которая, как говорят, немного быстрее, но поскольку она все еще имеет O (log n) термин в свертывании дерева Я подозреваю, что он будет в основном быстрее (если он есть) из-за того, как алгоритм реализован в отношении числа компьютерных операций по сравнению с использованием карты.Если людям будет интересно, я тоже разработаю эту версию.

В конце концов, нужно признать, что ни одна чисто функциональная реализация инкрементного EoS никогда не приблизится к скорости необработанной обработки хорошей императивной реализации для больших числовых диапазонов.Однако можно предложить подход, при котором весь код является чисто функциональным, за исключением сегментированного просеивания составных чисел в диапазоне с использованием (изменяемого) массива, который приблизился бы к производительности O (n), а при практическом использовании составил бы пятьдесятв сто раз быстрее, чем функциональные алгоритмы для больших диапазонов, таких как первые 200 000 000 простых чисел.Это было сделано @Jon Harrop в его блоге , но это можно было бы изменить, добавив совсем немного дополнительного кода.

5 голосов
/ 09 января 2011

Простое сито с процессорами почтовых ящиков:

let (<--) (mb : MailboxProcessor<'a>) (message : 'a) = mb.Post(message)
let (<-->) (mb : MailboxProcessor<'a>) (f : AsyncReplyChannel<'b> -> 'a) = mb.PostAndAsyncReply f

type 'a seqMsg =  
    | Next of AsyncReplyChannel<'a>   

type PrimeSieve() =   
    let counter(init) =   
        MailboxProcessor.Start(fun inbox ->   
            let rec loop n =   
                async { let! msg = inbox.Receive()   
                        match msg with
                        | Next(reply) ->   
                            reply.Reply(n)   
                            return! loop(n + 1) }   
            loop init)   

    let filter(c : MailboxProcessor<'a seqMsg>, pred) =   
        MailboxProcessor.Start(fun inbox ->   
            let rec loop() =   
                async {   
                    let! msg = inbox.Receive()   
                    match msg with
                    | Next(reply) ->
                        let rec filter prime =
                            if pred prime then async { return prime }
                            else async {
                                let! next = c <--> Next
                                return! filter next }
                        let! next = c <--> Next
                        let! prime = filter next
                        reply.Reply(prime)
                        return! loop()   
                }   
            loop()   
        )   

    let processor = MailboxProcessor.Start(fun inbox ->   
        let rec loop (oldFilter : MailboxProcessor<int seqMsg>) prime =   
            async {   
                let! msg = inbox.Receive()   
                match msg with
                | Next(reply) ->   
                    reply.Reply(prime)   
                    let newFilter = filter(oldFilter, (fun x -> x % prime <> 0))   
                    let! newPrime = oldFilter <--> Next
                    return! loop newFilter newPrime   
            }   
        loop (counter(3)) 2)   

    member this.Next() = processor.PostAndReply( (fun reply -> Next(reply)), timeout = 2000)

    static member upto max =
        let p = PrimeSieve()
        Seq.initInfinite (fun _ -> p.Next())
        |> Seq.takeWhile (fun prime -> prime <= max)
        |> Seq.toList
5 голосов
/ 08 января 2011

Вот моя попытка достаточно точного перевода кода на Haskell на F #:

#r "FSharp.PowerPack"

module Map =
  let insertWith f k v m =
    let v = if Map.containsKey k m then f m.[k] v else v
    Map.add k v m

let sieve =
  let rec sieve' map = function
  | LazyList.Nil -> Seq.empty
  | LazyList.Cons(x,xs) -> 
      if Map.containsKey x map then
        let facts = map.[x]
        let map = Map.remove x map
        let reinsert m p = Map.insertWith (@) (x+p) [p] m
        sieve' (List.fold reinsert map facts) xs
      else
        seq {
          yield x
          yield! sieve' (Map.add (x*x) [x] map) xs
        }
  fun s -> sieve' Map.empty (LazyList.ofSeq s)

let rec upFrom i =
  seq {
    yield i
    yield! upFrom (i+1)
  }

let primes = sieve (upFrom 2)
3 голосов
/ 16 июля 2013

Вот еще один метод выполнения инкрементального сита Эратосфена (SoE) с использованием только чистого функционального кода F #. Он адаптирован из кода на Haskell, разработанного как «Эта идея принадлежит Дейву Байеру, хотя он использовал сложную формулировку и сбалансированную трехкомпонентную структуру дерева, постепенно углубляясь равномерно (упрощенная формулировка и перекошенное углубление до правильной структуры двоичного дерева введены» Генрих Апфельмус, далее упрощенный Уиллом Нессом. Идея поэтапного производства благодаря М. О'Нилу "по следующей ссылке: Оптимизированный код сворачивания дерева с использованием факториального колеса в Haskell .

Следующий код имеет несколько оптимизаций, которые делают его более подходящим для выполнения в F #, следующим образом:

  1. Код использует коиндуктивные потоки вместо LazyList, поскольку этот алгоритм не требует (или мало) необходимости в запоминании LazyList, а мои коиндуктивные потоки более эффективны, чем LazyLists (из FSharp.PowerPack) или встроенные последовательности. Еще одним преимуществом является то, что мой код можно запустить на tryFSharp.org и ideone.com без необходимости копировать и вставлять исходный код Microsoft.FSharp.PowerPack Core для типа LazyList и модуль (вместе с уведомлением об авторских правах)

  2. Было обнаружено, что при сопоставлении шаблонов F # с параметрами функции довольно много служебной информации, поэтому предыдущий, более читаемый тип различаемого объединения, использующий кортежи, был принесен в жертву в пользу структуры по значению (или класса, который работает быстрее на некоторые платформы) набирают скорость примерно в два или более раз.

  3. Будет ли оптимизация Несса от линейного свертывания дерева до двустороннего свертывания к многоходовому свертыванию и улучшений с использованием факторизации колеса примерно так же эффективна для F #, как и для Haskell, с основным отличием между двумя языками: что Haskell может быть скомпилирован в нативный код и имеет более высокооптимизированный компилятор, тогда как F # имеет больше накладных расходов, работающих в системе DotNet Framework.

    type prmstate = struct val p:uint32 val pi:byte new (prm,pndx) = { p = prm; pi = pndx } end
    type prmsSeqDesc = struct val v:prmstate val cont:unit->prmsSeqDesc new(ps,np) = { v = ps; cont = np } end
    type cmpststate = struct val cv:uint32 val ci:byte val cp:uint32 new (strt,ndx,prm) = {cv = strt;ci = ndx;cp = prm} end
    type cmpstsSeqDesc = struct val v:cmpststate val cont:unit->cmpstsSeqDesc new (cs,nc) = { v = cs; cont = nc } end
    type allcmpsts = struct val v:cmpstsSeqDesc val cont:unit->allcmpsts new (csd,ncsdf) = { v=csd;cont=ncsdf } end
    
    let primesTFWSE =
      let whlptrn = [| 2uy;4uy;2uy;4uy;6uy;2uy;6uy;4uy;2uy;4uy;6uy;6uy;2uy;6uy;4uy;2uy;6uy;4uy;6uy;8uy;4uy;2uy;4uy;2uy;
                       4uy;8uy;6uy;4uy;6uy;2uy;4uy;6uy;2uy;6uy;6uy;4uy;2uy;4uy;6uy;2uy;6uy;4uy;2uy;4uy;2uy;10uy;2uy;10uy |]
      let inline whladv i = if i < 47uy then i + 1uy else 0uy
      let inline advmltpl c ci p = cmpststate (c + uint32 whlptrn.[int ci] * p,whladv ci,p)
      let rec pmltpls cs = cmpstsSeqDesc(cs,fun() -> pmltpls (advmltpl cs.cv cs.ci cs.cp))
      let rec allmltpls (psd:prmsSeqDesc) =
        allcmpsts(pmltpls (cmpststate(psd.v.p*psd.v.p,psd.v.pi,psd.v.p)),fun() -> allmltpls (psd.cont()))
      let rec (^) (xs:cmpstsSeqDesc) (ys:cmpstsSeqDesc) = //union op for SeqDesc's
        match compare xs.v.cv ys.v.cv with
          | -1 -> cmpstsSeqDesc (xs.v,fun() -> xs.cont() ^ ys)
          | 0 -> cmpstsSeqDesc (xs.v,fun() -> xs.cont() ^ ys.cont())
          | _ -> cmpstsSeqDesc(ys.v,fun() -> xs ^ ys.cont()) //must be greater than
      let rec pairs (csdsd:allcmpsts) =
        let ys = csdsd.cont in
        allcmpsts(cmpstsSeqDesc(csdsd.v.v,fun()->csdsd.v.cont()^ys().v),fun()->pairs (ys().cont()))
      let rec joinT3 (csdsd:allcmpsts) = cmpstsSeqDesc(csdsd.v.v,fun()->
        let ys = csdsd.cont() in let zs = ys.cont() in (csdsd.v.cont()^(ys.v^zs.v))^joinT3 (pairs (zs.cont())))
      let rec mkprimes (ps:prmstate) (csd:cmpstsSeqDesc) =
        let nxt = ps.p + uint32 whlptrn.[int ps.pi]
        if ps.p >= csd.v.cv then mkprimes (prmstate(nxt,whladv ps.pi)) (csd.cont()) //minus function
        else prmsSeqDesc(prmstate(ps.p,ps.pi),fun() -> mkprimes (prmstate(nxt,whladv ps.pi)) csd)
      let rec baseprimes = prmsSeqDesc(prmstate(11u,0uy),fun() -> mkprimes (prmstate(13u,1uy)) initcmpsts)
      and initcmpsts = joinT3 (allmltpls baseprimes)
      let genseq sd = Seq.unfold (fun (psd:prmsSeqDesc) -> Some(psd.v.p,psd.cont())) sd
      seq { yield 2u; yield 3u; yield 5u; yield 7u; yield! mkprimes (prmstate(11u,0uy)) initcmpsts |> genseq }
    
    primesLMWSE |> Seq.nth 100000
    

EDIT_ADD: Это исправлено, поскольку исходный код неправильно обрабатывал хвост потока и передавал хвост потока параметра в функцию пар функции joinT3, а не хвост после поток Соответствующее время также было соответствующим образом скорректировано с ускорением примерно на 30%. Коды ссылок tryFSharp и ideone также были исправлены. END_EDIT_ADD

Вышеприведенная программа работает с производительностью около O (n ^ 1.1) при n вычисленном максимальном простом числе или около O (n ^ 1.18), когда n - это число вычисленных простых чисел, и для вычисления первого миллиона простых чисел требуется около 2,16 секунды (около 0,14 секунды для первых 100 000 простых чисел) на быстром компьютере, работающем с 64-битным кодом, использующим структурные типы, а не классы (кажется, что некоторые реализации блокируют и распаковывают структуры по значению при формировании замыканий). Я считаю, что это будет максимальный практический диапазон для любого из этих чисто функциональных простых алгоритмов. Вероятно, это самое быстрое, что можно запустить чисто функциональный алгоритм SoE, за исключением незначительных изменений, чтобы уменьшить постоянные факторы.

Помимо сочетания сегментации и многопоточности для совместного использования вычислений между несколькими ядрами ЦП, большинство «настроек», которые можно было бы сделать с этим алгоритмом, заключаются в увеличении длины факторизации колеса для усиления примерно до 40. % в производительности и незначительный выигрыш из-за изменений в использовании структур, классов, кортежей или более прямых индивидуальных параметров при передаче состояния между функциями.

EDIT_ADD2: Я провел вышеупомянутые оптимизации, в результате чего код теперь почти в два раза быстрее благодаря оптимизации структуры с дополнительным бонусом при дополнительном использовании дополнительных окружностей факторизации колес для дополнительного меньшего сокращения , Обратите внимание, что приведенный ниже код избегает использования продолжений в цикле генерации основной последовательности и использует их только там, где это необходимо, для потоков базовых простых чисел и последующих составных потоков отбора чисел, полученных из этих базовых простых чисел. Новый код выглядит следующим образом:

type CIS<'T> = struct val v:'T val cont:unit->CIS<'T> new(v,cont) = { v=v;cont=cont } end //Co-Inductive Steam
let primesTFOWSE =
  let WHLPRMS = [| 2u;3u;5u;7u |] in let FSTPRM = 11u in let WHLCRC = int (WHLPRMS |> Seq.fold (*) 1u) >>> 1
  let WHLLMT = int (WHLPRMS |> Seq.fold (fun o n->o*(n-1u)) 1u) - 1
  let WHLPTRN =
    let wp = Array.zeroCreate (WHLLMT+1)
    let gaps (a:int[]) = let rec gap i acc = if a.[i]=0 then gap (i+1) (acc+1uy) else acc
                         {0..WHLCRC-1} |> Seq.fold (fun s i->
                           let ns = if a.[i]<>0 then wp.[s]<-2uy*gap (i+1) 1uy;(s+1) else s in ns) 0 |> ignore
    Array.init (WHLCRC+1) (fun i->if WHLPRMS |> Seq.forall (fun p->(FSTPRM+uint32(i<<<1))%p<>0u)
                                  then 1 else 0) |> gaps;wp
  let inline whladv i = if i < WHLLMT then i+1 else 0 in let inline advcnd c ci = c + uint32 WHLPTRN.[ci]
  let inline advmltpl p (c,ci) = (c + uint32 WHLPTRN.[ci] * p,whladv ci)
  let rec pmltpls p cs = CIS(cs,fun() -> pmltpls p (advmltpl p cs))
  let rec allmltpls k wi (ps:CIS<_>) =
    let nxt = advcnd k wi in let nxti = whladv wi
    if k < ps.v then allmltpls nxt nxti ps
    else CIS(pmltpls ps.v (ps.v*ps.v,wi),fun() -> allmltpls nxt nxti (ps.cont()))
  let rec (^) (xs:CIS<uint32*_>) (ys:CIS<uint32*_>) = 
    match compare (fst xs.v) (fst ys.v) with //union op for composite CIS's (tuple of cmpst and wheel ndx)
      | -1 -> CIS(xs.v,fun() -> xs.cont() ^ ys)
      | 0 -> CIS(xs.v,fun() -> xs.cont() ^ ys.cont())
      | _ -> CIS(ys.v,fun() -> xs ^ ys.cont()) //must be greater than
  let rec pairs (xs:CIS<CIS<_>>) =
    let ys = xs.cont() in CIS(CIS(xs.v.v,fun()->xs.v.cont()^ys.v),fun()->pairs (ys.cont()))
  let rec joinT3 (xs:CIS<CIS<_>>) = CIS(xs.v.v,fun()->
    let ys = xs.cont() in let zs = ys.cont() in (xs.v.cont()^(ys.v^zs.v))^joinT3 (pairs (zs.cont())))
  let rec mkprm (cnd,cndi,(csd:CIS<uint32*_>)) =
    let nxt = advcnd cnd cndi in let nxti = whladv cndi
    if cnd >= fst csd.v then mkprm (nxt,nxti,csd.cont()) //minus function
    else (cnd,cndi,(nxt,nxti,csd))
  let rec pCIS p pi cont = CIS(p,fun()->let (np,npi,ncont)=mkprm cont in pCIS np npi ncont)
  let rec baseprimes() = CIS(FSTPRM,fun()->let np,npi = advcnd FSTPRM 0,whladv 0
                                           pCIS np npi (advcnd np npi,whladv npi,initcmpsts))
  and initcmpsts = joinT3 (allmltpls FSTPRM 0 (baseprimes()))
  let inline genseq sd = Seq.unfold (fun (p,pi,cont) -> Some(p,mkprm cont)) sd
  seq { yield! WHLPRMS; yield! mkprm (FSTPRM,0,initcmpsts) |> genseq }

Приведенный выше код занимает около 0,07, 1,02 и 14,58 секунд, чтобы перечислить первые сто тысяч, десять миллионов и десять миллионов простых чисел, соответственно, на эталонной машине Intel i7-2700K (3,5 ГГц) в 64-битном режиме. Это не намного медленнее, чем эталонная реализация на Haskell, из которой был получен этот код, хотя он немного медленнее на tryfsharp и ideone из-за нахождения в 32-битном режиме для tryfsharp под Silverlight (примерно вдвое медленнее) и работает на более медленной машине под Mono 2.0 (которая по своей сути намного медленнее для F #) на ideone, так что примерно в пять раз медленнее, чем на эталонной машине. Обратите внимание, что время выполнения, сообщаемое ideone, включает время инициализации для встроенных массивов справочных таблиц, которое необходимо учитывать.

Вышеуказанная программа имеет еще одну особенность, заключающуюся в том, что колесо факторизации параметризовано так, что, например, можно использовать очень большое колесо, установив WHLPRMS в [| 2u; 3u; 5u; 7u; 11u; 13u; 17u; 19u |] и FSTPRM до 23u, чтобы получить время пробега около двух третей для больших диапазонов при 10,02 секунды для десяти миллионов простых чисел, хотя следует учесть, что для этого требуется несколько секунд вычислите WHLPTRN до запуска программы.

Замечание Geek: я не реализовал «не разделяющий комбинатор фиксированных точек для телескопирования многостадийного производства простых чисел» согласно эталонному коду Haskell, хотя я пытался это сделать, потому что для этого нужно иметь что-то вроде ленивого списка Haskell. работать, не убегая в бесконечный цикл и переполнение стека. Хотя мои коиндуктивные потоки (CIS) имеют некоторые свойства лени, они не являются формально ленивыми списками или кэшированными последовательностями (они становятся не кэшированными последовательностями и могут быть кэшированы при передаче таким образом, как функция "genseq", которую я предоставляю окончательная выходная последовательность). Я не хотел использовать реализацию PowerPack LazyList, потому что она не очень эффективна и потребовала бы, чтобы я скопировал этот исходный код в tryfsharp и ideone, которые не предусматривают импортированные модули. Использование встроенных последовательностей (даже кэшированных) очень неэффективно, когда требуется использовать операции head / tail, которые требуются для этого алгоритма, поскольку единственный способ получить хвост последовательности - это использовать «Seq.skip 1», который на многократное использование создает новую последовательность, основанную на исходной последовательности, рекурсивно пропускаемой много раз. Я мог бы реализовать свой собственный эффективный класс LazyList, основанный на CIS, но вряд ли стоит демонстрировать момент, когда рекурсивные объекты initcmpsts и baseprimes занимают очень мало кода. Кроме того, передача LazyList в функцию для создания расширений для этого LazyList, функция которого использует значения только в начале Lazylist, требует, чтобы почти весь LazyList запоминался для снижения эффективности памяти: проход для первых 10 миллионов простых чисел потребует LazyList в памяти с почти 180 миллионами элементов. Так что я взял пропуск на это.

Обратите внимание, что для больших диапазонов (10 миллионов простых чисел и более) этот чисто функциональный код имеет примерно ту же скорость, что и многие упрощенные императивные реализации Сита Эратосфена или Аткинса, хотя это связано с отсутствием оптимизации этих императивных алгоритмы; более настоятельная реализация, чем эта, с использованием эквивалентных оптимизаций и сегментированных массивов просеивания, все равно будет примерно в десять раз быстрее, чем это, согласно моему «почти функциональному» ответу.

Также обратите внимание, что хотя можно реализовать сегментированное просеивание с использованием свертывания деревьев, это сложнее, так как алгоритмы продвижения отбраковки скрыты внутри продолжений, используемых для оператора "union - ^", и обход этого может означать, что непрерывнонеобходимо использовать дальность отбраковки;это не похоже на другие алгоритмы, в которых состояние переменной отбраковки может быть сброшено для каждой новой страницы, включая уменьшение их диапазона, так что, если используются диапазоны, превышающие 32 бита, внутренний отбракованный диапазон все еще можно сбросить для работы в пределах 32-битный диапазон, даже когда 64-битный диапазон простых чисел определяется с небольшими затратами времени выполнения на простое число. END_EDIT_ADD2

3 голосов
/ 09 января 2011

Я знаю, что вы прямо заявили, что вы заинтересованы в чисто функциональной реализации сита, поэтому я не стал представлять свое сито до сих пор. Но после перечитывания статьи, на которую вы ссылались, я вижу, что представленный алгоритм инкрементального сита в сущности такой же, как и мой, единственное отличие состоит в деталях реализации использования чисто функциональных и решительно обязательных методов. Так что я думаю, что по крайней мере наполовину готов удовлетворить ваше любопытство. Более того, я бы сказал, что использование императивных методов, когда можно добиться значительного прироста производительности, но скрыть их от функциональных интерфейсов, является одним из самых мощных методов, поощряемых в программировании на F #, в отличие от абсолютно чистой культуры Haskell. Я впервые опубликовал эту реализацию в моем Project Euler для F # un blog , но переиздаю здесь с заменой необходимого кода и удалением структурной типизации. primes может вычислить первые 100 000 простых чисел за 0,248 секунды и первые 1 000 000 простых чисел за 4,8 секунды на моем компьютере (обратите внимание, что primes кэширует его результаты, поэтому вам придется пересматривать его каждый раз, когда вы выполняете тест).

let inline infiniteRange start skip = 
    seq {
        let n = ref start
        while true do
            yield n.contents
            n.contents <- n.contents + skip
    }

///p is "prime", s=p*p, c is "multiplier", m=c*p
type SievePrime<'a> = {mutable c:'a ; p:'a ; mutable m:'a ; s:'a}

///A cached, infinite sequence of primes
let primes =
    let primeList = ResizeArray<_>()
    primeList.Add({c=3 ; p=3 ; m=9 ; s=9})

    //test whether n is composite, if not add it to the primeList and return false
    let isComposite n = 
        let rec loop i = 
            let sp = primeList.[i]
            while sp.m < n do
                sp.c <- sp.c+1
                sp.m <- sp.c*sp.p

            if sp.m = n then true
            elif i = (primeList.Count-1) || sp.s > n then
                primeList.Add({c=n ; p=n ; m=n*n ; s=n*n})
                false
            else loop (i+1)
        loop 0

    seq { 
        yield 2 ; yield 3

        //yield the cached results
        for i in 1..primeList.Count-1 do
            yield primeList.[i].p

        yield! infiniteRange (primeList.[primeList.Count-1].p + 2) 2 
               |> Seq.filter (isComposite>>not)
    }
3 голосов
/ 09 января 2011

Как бы то ни было, это не сито Эратотен, а его очень быстрый:

let is_prime n =
    let maxFactor = int64(sqrt(float n))
    let rec loop testPrime tog =
        if testPrime > maxFactor then true
        elif n % testPrime = 0L then false
        else loop (testPrime + tog) (6L - tog)
    if n = 2L || n = 3L || n = 5L then true
    elif n <= 1L || n % 2L = 0L || n % 3L = 0L || n % 5L = 0L then false
    else loop 7L 4L
let primes =
    seq {
        yield 2L;
        yield 3L;
        yield 5L;
        yield! (7L, 4L) |> Seq.unfold (fun (p, tog) -> Some(p, (p + tog, 6L - tog)))
    }
    |> Seq.filter is_prime

Он находит 100 000-е простое число за 1,25 секунды на моей машине (AMD Phenom II, 3,2 ГГц).

3 голосов
/ 08 января 2011

Вот мои два цента, хотя я не уверен, что он соответствует критерию ФП для того, чтобы действительно быть ситом эратосфена. Он не использует модульное разделение и реализует оптимизацию из статьи, цитируемой ОП. Это работает только для конечных списков, но мне кажется, что это соответствует духу первоначального описания сита. Кроме того, в статье рассказывается о сложности с точки зрения количества маркировки и количества делений. Похоже, что, поскольку нам приходится проходить через связанный список, это, возможно, игнорирует некоторые ключевые аспекты различных алгоритмов с точки зрения производительности. В целом, хотя модульное разделение с компьютерами - дорогая операция.

open System

let rec sieve list =
    let rec helper list2 prime next =
        match list2 with
            | number::tail -> 
                if number< next then
                    number::helper tail prime next
                else
                    if number = next then 
                        helper tail prime (next+prime)
                    else
                        helper (number::tail) prime (next+prime)

            | []->[]
    match list with
        | head::tail->
            head::sieve (helper tail head (head*head))
        | []->[]

let step1=sieve [2..100]

РЕДАКТИРОВАТЬ: исправлена ​​ошибка в коде из моего исходного поста. Я попытался следовать оригинальной логике сита с несколькими модификациями. А именно, начните с первого элемента и вычеркните кратные этому элементу из набора. Этот алгоритм буквально ищет следующий элемент, кратный простому, вместо выполнения модульного деления на каждом числе в наборе. Оптимизация из статьи заключается в том, что она начинает искать кратные простого числа, большего, чем p ^ 2.

Часть в вспомогательной функции с многоуровневой функцией имеет возможность того, что следующий кратный простого числа уже может быть удален из списка. Так, например, для простого 5 он попытается удалить число 30, но никогда не найдет его, потому что он уже был удален простым 3. Надежда, которая проясняет логику алгоритма.

2 голосов
/ 01 августа 2013

Поскольку этот вопрос специально запрашивает другие алгоритмы, я предоставляю следующую реализацию:

или, возможно, знает об альтернативных методах реализации или алгоритмах просеивания

Нет представления различныхАлгоритмы Sieve of Eratosthenes (SoE) действительно полны без упоминания Sieve of Atkin (SoA), которое на самом деле является вариацией SoE, использующей решения для ряда квадратных уравнений для реализации составного отбора.как устранение всех кратных квадратов базовых простых чисел (простых чисел, меньших или равных квадратному корню из наибольшего числа, проверенного на простоту).Теоретически, SoA более эффективен, чем SoE, так как в этом диапазоне операций немного меньше, поэтому его сложность должна быть примерно на 20% меньше для диапазона от 10 до 100 миллионов, но практически он обычно медленнее из-завычислительные накладные расходы на сложность решения нескольких квадратных уравнений.Хотя высокооптимизированная реализация C Даниэля Бернштейна быстрее, чем реализация SoE, с которой он тестировал ее для этого конкретного диапазона номеров тестов , реализация SoE, с которой он тестировал, былане самые оптимальные и более оптимизированные версии прямой SoE все еще быстрее.Это, похоже, имеет место в данном случае, хотя я допускаю, что могут быть и другие оптимизации, которые я пропустил.

Поскольку О'Нил в своей статье о SoE, использующей инкрементальные неограниченные сита, изложила прежде всего, чтобы показать, что ТернерСито не является SoE как в отношении алгоритма, так и в отношении производительности, она не учитывала многие другие варианты SoE, такие как SoA.Выполняя быстрый поиск литературы, я не могу найти применение SoA к неограниченным инкрементным последовательностям, которые мы здесь обсуждаем, поэтому адаптировал его сам, как в следующем коде.

Так же, как можно рассматривать чистый неограниченный случай SoEчтобы иметь в качестве составных чисел неограниченную последовательность последовательностей, кратных простым числам, SoA считает, что потенциальными простыми числами может быть неограниченная последовательность неограниченных последовательностей всех выражений квадратных уравнений с одной из двух свободных переменных, 'x' или'y' фиксируется на начальном значении и с отдельной последовательностью «исключения» последовательностей всех кратных базовых простых чисел, которая в последний раз очень похожа на составные последовательности исключения последовательностей для SoE, за исключением того, что последовательности продвигаются быстрееквадратом простых чисел, а не (меньшим) кратным простых чисел.Я попытался уменьшить количество последовательностей квадратичных уравнений, выраженных в признании того, что для последовательного сита последовательности «3 * x ^ 2 + y ^ 2» и «3 * x ^ 2 - y ^ 2»на самом деле то же самое, за исключением знака второго члена и исключения всех не странных решений, а также применения факторизации 2357 колес (хотя SoA уже имеет факторизацию 235 колес).Он использует эффективный алгоритм объединения / комбинирования сворачивания деревьев, как при объединении дерева SoE, чтобы иметь дело с каждой последовательностью последовательностей, но с упрощением, которое оператор объединения не объединяет при объединении, поскольку алгоритм SoA зависит от возможности переключения основного состояния на основеколичество найденных квадратичных решений для конкретного значения.Код работает медленнее, чем SoE, объединяющее дерево, из-за примерно в три раза числа служебных операций, примерно в три раза превышающего количество несколько более сложных последовательностей, но, вероятно, существует диапазон просеивания очень больших чисел, при котором он пропускает SoE из-заего теоретическое преимущество в производительности.

Следующий код верен для формулировки SoA, использует типы CoInductive Stream, а не LazyList или последовательности, так как запоминание не требуется, а производительность лучше, также не используются дискриминированные объединения иизбегает сопоставления с образцом по соображениям производительности:

#nowarn "40"
type cndstate = class val c:uint32 val wi:byte val md12:byte new(cnd,cndwi,mod12) = { c=cnd;wi=cndwi;md12=mod12 } end
type prmsCIS = class val p:uint32 val cont:unit->prmsCIS new(prm,nxtprmf) = { p=prm;cont=nxtprmf } end
type stateCIS<'b> = class val v:uint32 val a:'b val cont:unit->stateCIS<'b> new(curr,aux,cont)= { v=curr;a=aux;cont=cont } end
type allstateCIS<'b> = class val ss:stateCIS<'b> val cont:unit->allstateCIS<'b> new(sbstrm,cont) = { ss=sbstrm;cont=cont } end

let primesTFWSA() =
  let WHLPTRN = [| 2uy;4uy;2uy;4uy;6uy;2uy;6uy;4uy;2uy;4uy;6uy;6uy;2uy;6uy;4uy;2uy;6uy;4uy;6uy;8uy;4uy;2uy;4uy;2uy;
                   4uy;8uy;6uy;4uy;6uy;2uy;4uy;6uy;2uy;6uy;6uy;4uy;2uy;4uy;6uy;2uy;6uy;4uy;2uy;4uy;2uy;10uy;2uy;10uy |]
  let rec prmsqrs v sqr = stateCIS(v,sqr,fun() -> let n=v+sqr+sqr in let n=if n<v then 0xFFFFFFFFu else n in prmsqrs n sqr)
  let rec allsqrs (prms:prmsCIS) = let s = prms.p*prms.p in allstateCIS(prmsqrs s s,fun() -> allsqrs (prms.cont()))
  let rec qdrtc v y = stateCIS(v,y,fun() -> let a=(y+1)<<<2 in let a=if a<=0 then (if a<0 then -a else 2) else a
                                            let vn=v+uint32 a in let vn=if vn<v then 0xFFFFFFFFu else vn in qdrtc vn (y+2))
  let rec allqdrtcsX4 x = allstateCIS(qdrtc (((x*x)<<<2)+1u) 1,fun()->allqdrtcsX4 (x+1u))
  let rec allqdrtcsX3 x = allstateCIS(qdrtc (((x*(x+1u))<<<1)-1u) (1 - int x),fun() -> allqdrtcsX3 (x+1u))
  let rec joinT3 (ass:allstateCIS<'b>) = stateCIS<'b>(ass.ss.v,ass.ss.a,fun()->
    let rec (^) (xs:stateCIS<'b>) (ys:stateCIS<'b>) = //union op for CoInductiveStreams
      match compare xs.v ys.v with
        | 1 -> stateCIS(ys.v,ys.a,fun() -> xs ^ ys.cont())
        | _ -> stateCIS(xs.v,xs.a,fun() -> xs.cont() ^ ys) //<= then keep all the values without combining
    let rec pairs (ass:allstateCIS<'b>) =
      let ys = ass.cont
      allstateCIS(stateCIS(ass.ss.v,ass.ss.a,fun()->ass.ss.cont()^ys().ss),fun()->pairs (ys().cont()))
    let ys = ass.cont() in let zs = ys.cont() in (ass.ss.cont()^(ys.ss^zs.ss))^joinT3 (pairs (zs.cont())))
  let rec mkprm (cs:cndstate) (sqrs:stateCIS<_>) (qX4:stateCIS<_>) (qX3:stateCIS<_>) tgl =
    let inline advcnd (cs:cndstate) =
      let inline whladv i = if i < 47uy then i + 1uy else 0uy
      let inline modadv m a = let md = m + a in if md >= 12uy then md - 12uy else md
      let a = WHLPTRN.[int cs.wi] in let nc = cs.c+uint32 a
      if nc<cs.c then failwith "Tried to enumerate primes past the numeric range!!!"
      else cndstate(nc,whladv cs.wi,modadv cs.md12 a)
    if cs.c>=sqrs.v then mkprm (if cs.c=sqrs.v then advcnd cs else cs) (sqrs.cont()) qX4 qX3 false //squarefree function
    elif cs.c>qX4.v then mkprm cs sqrs (qX4.cont()) qX3 false
    elif cs.c>qX3.v then mkprm cs sqrs qX4 (qX3.cont()) false
    else match cs.md12 with
            | 7uy -> if cs.c=qX3.v then mkprm cs sqrs qX4 (qX3.cont()) (if qX3.a>0 then not tgl else tgl) //only for a's are positive
                     elif tgl then prmsCIS(cs.c,fun() -> mkprm (advcnd cs) sqrs qX4 qX3 false)
                     else mkprm (advcnd cs) sqrs qX4 qX3 false
            | 11uy -> if cs.c=qX3.v then mkprm cs sqrs qX4 (qX3.cont()) (if qX3.a<0 then not tgl else tgl) //only for a's are negatve
                      elif tgl then prmsCIS(cs.c,fun() -> mkprm (advcnd cs) sqrs qX4 qX3 false)
                      else mkprm (advcnd cs) sqrs qX4 qX3 false
            | _ -> if cs.c=qX4.v then mkprm cs sqrs (qX4.cont()) qX3 (not tgl) //always must be 1uy or 5uy
                   elif tgl then prmsCIS(cs.c,fun() -> mkprm (advcnd cs) sqrs qX4 qX3 false)
                   else mkprm (advcnd cs) sqrs qX4 qX3 false
  let qX4s = joinT3 (allqdrtcsX4 1u) in let qX3s = joinT3 (allqdrtcsX3 1u)
  let rec baseprimes = prmsCIS(11u,fun() -> mkprm (cndstate(13u,1uy,1uy)) initsqrs qX4s qX3s false)
  and initsqrs = joinT3 (allsqrs baseprimes)
  let genseq ps = Seq.unfold (fun (psd:prmsCIS) -> Some(psd.p,psd.cont())) ps
  seq { yield 2u; yield 3u; yield 5u; yield 7u;
        yield! mkprm (cndstate(11u,0uy,11uy)) initsqrs qX4s qX3s false |> genseq }

Как уже говорилось, код медленнее, чем SoE, оптимизированный для колеса складывания деревьев, как было опубликовано в другом ответе, примерно в половине секунды для первых 100 000 простых чисел, и имеет примерно то же эмпирическое значение O (n ^ 1.2) для найденных простых чисел, что и для лучшее из других чисто функциональных решений. Некоторые дальнейшие оптимизации, которые можно попробовать, состоят в том, что последовательности простых чисел не используют факторизацию колеса для устранения 357 кратных квадратов или даже используют только простые кратные простых квадратов, чтобы уменьшить количество значений в потоках последовательности квадратов и, возможно, другие оптимизации, связанные с потоками последовательности выражений квадратного уравнения.

EDIT_ADD: Мне потребовалось немного времени, чтобы посмотреть на оптимизацию по модулю SoA и увидеть, что в дополнение к вышеописанным оптимизациям "без квадратов", которые, вероятно, не будут иметь большого значения, квадратичные последовательности иметь шаблон по модулю для каждых 15 элементов, который позволил бы предварительно проверять многие из переданных переключенных составных тестовых значений и исключил бы необходимость в определенных операциях по модулю 12 для каждого составного числа. Все эти оптимизации, вероятно, приведут к сокращению вычислительной работы, представляемой сворачиванию дерева, примерно до 50%, чтобы сделать чуть более оптимизированную версию SoA работающей на уровне, близком или чуть лучше, чем у лучшего SoE, объединяющего сложение деревьев. Я не знаю, когда я смогу найти время, чтобы провести несколько дней расследования, чтобы определить результат. END_EDIT_ADD

EDIT_ADD2: Работая над вышеуказанными оптимизациями, которые действительно увеличат производительность примерно в два раза, я понимаю, почему текущая эмпирическая производительность с увеличением n не так хороша, как SoE: в то время как SoE особенно подходит для операций свертывания дерева тем, что первые последовательности более плотные и повторяются чаще с более поздними последовательностями, гораздо менее плотными, последовательности SoA «4X» плотнее для более поздних последовательностей, когда они добавляются, и в то время как последовательности «3X» начинаются менее плотные, они становятся более плотными при приближении y к нулю, а затем снова становятся менее плотными; это означает, что последовательности вызова / возврата не сохраняются на минимальной глубине, как для SoE, но эта глубина увеличивается за пределы пропорциональности диапазону номеров. Решения, использующие свертывание, не очень хороши, так как можно реализовать левое сворачивание для последовательностей, которые со временем увеличивают плотность, но это все еще оставляет плохо оптимизированными отрицательные части последовательностей «3X», как и разбиение последовательностей «3X» на положительные и отрицательные части. Самым простым решением, вероятно, является сохранение всех последовательностей на карте, что означает, что время доступа увеличится на что-то вроде логарифма квадратного корня диапазона, но это будет лучше для большего диапазона номеров, чем текущее сворачивание дерева. END_EDIT_ADD2

Хотя и медленнее, я представляю это решение здесь, чтобы показать, как можно развить код, чтобы выразить идеи, изначально задуманные в чистом функциональном коде на F #. В нем приводятся примеры использования продолжений, как в CoInductive Streams, для реализации лени без использования типа Lazy, реализации (хвостовых) рекурсивных циклов, чтобы избежать каких-либо требований к изменчивости, потокового накопителя (tgl) через рекурсивные вызовы для получения результата (числа раз квадратные уравнения «ударили» проверенное число), представляя решения уравнений в виде (ленивых) последовательностей (или потоков в данном случае) и так далее.

Для тех, кто хотел бы продолжить играть с этим кодом даже без системы разработки на базе Windows, я также разместил его на tryfsharp.org и Ideone.com , хотя работает медленнее на обеих этих платформах, при этом tryfsharp пропорционально скорости локальной клиентской машины и медленнее из-за работы под Silverlight, а Ideone работает на ЦП сервера Linux в Mono-проекте 2.0, который, как известно, медленен как в реализации, так и в особенно в отношении сборок мусора.

...