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

Ответ 1

Чтение этой статьи я придумал идею, которая не требует мультимапа. Он обрабатывает сталкивающиеся ключи карты, перемещая встречный ключ вперед своим основным значением снова и снова, пока не достигнет ключа, который не находится на карте. Ниже 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

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

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

Ответ 2

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

A 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 не требует его, но есть функция "настроить" для использования в сегментации):

[<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 можно записать с оптимизацией факторизации колес и использовать эффективные Co-индуктивные потоки (CIS) следующим образом:

type CIS<'T> = class val v:'T val cont:unit->CIS<'T> new(v,cont) = { v=v;cont=cont } 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.pi,cullstate(kv.v.p,whladv kv.v.pi)
                                                   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 секунды, первые 1000 000 простых чисел в 0,977 секунды, первые 10 000 000 простых чисел примерно за 14,33 секунды и первые 100 000 000 простых чисел примерно за 221,87 секунды, все на i7-2700K ( 3,5 ГГц) в виде 64-битного кода. Этот чисто функциональный код немного быстрее, чем Dustin Cambell изменяет словарь на основе словаря с добавленной общей оптимизацией факторизации колес, отложенным добавлением базовых простых чисел, и использование более эффективного 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 и Map, улучшения обычно являются постоянным фактором в сокращении числа операций 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 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 и случайного поведения простого отбрака значения, означающие, что предсказание ветвления CPU не выполняется для значительной части ветвей, что приводит к множеству дополнительных 10 тактовых циклов ЦП на единицу сокращения для восстановления кэша предварительной выборки команд.

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

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

Код с добавлением сегментации, многопоточности, программируемой колесной факториальной окружности и многими улучшениями производительности выглядит следующим образом (кроме некоторых добавленных новых констант, дополнительный настроенный код для реализации сегментации и многопоточности является нижней частью примерно наполовину кода, начинающегося с функции "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.pi,cullstate(kv.v.p,whladv kv.v.pi)
                        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.pi]
        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, как функциональные, так и массивные, добавили функцию "настройки", чтобы разрешить настройку состояния отбраковки каждой версии потока 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,22,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, вероятно, являются адекватными и довольно простыми для записи или имеют меньшую память RAM, чем простейшие императивные SoE. Тем не менее, они намного медленнее, чем более требовательный код, используя массив, чтобы они "выходили из-под контроля" для диапазонов выше этого. Хотя здесь было продемонстрировано, что код может ускоряться оптимизацией, он все еще в 10 раз медленнее, чем более настоятельная версия на основе чистого массива, но добавила, что сложность будет по меньшей мере такой же сложной, как этот код с эквивалентной оптимизацией, и даже этот код под F # на DotNet примерно в четыре раза медленнее, чем использование языка, такого как С++, скомпилированного непосредственно на собственный код; если бы действительно хотелось исследовать большие диапазоны простых чисел, можно было бы использовать один из тех других языков и методов, где primesieveможет рассчитать количество простых чисел в сто триллионах диапазонов менее чем за четыре часа вместо трех месяцев, необходимых для этого кода. END_EDIT_ADD

Ответ 3

Здесь моя попытка относительно корректного перевода кода 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)

Ответ 4

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

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

Вот максимально оптимизированная по алгоритму инкрементная (и рекурсивная) карта, основанная на Sieve of Eratosthenes, с использованием последовательностей, поскольку нет необходимости в запоминании предыдущих значений последовательности (кроме небольшого преимущества для кэширования базовых простых значений используя 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 секунды, чтобы найти 1000 000 простых чисел до 15 485 867 для производительности в этом диапазоне около O (n ^ 1.2), где n - максимальное максимальное количество найденных.

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

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

• Можно использовать другие формы хранения карт, такие как очередь приоритетов, как упоминалось O'Neil или 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 в его блоге, но это может быть настроено дальше с очень небольшим дополнительным кодом.

Ответ 6

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

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]

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

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

Ответ 7

Я знаю, что вы прямо заявили, что вас интересует чисто функциональная решеточная сита, поэтому я до сих пор оставил представление о сите. Но после повторного чтения бумаги, на которую вы ссылались, я вижу, что алгоритм инкрементного сита представлен в основном таким же, как и мой собственный, единственная разница - это детали реализации использования чисто функциональных методов по сравнению с явно императивными методами. Поэтому я думаю, что, по крайней мере, полу-квалификацию удовлетворяю ваше любопытство. Более того, я бы сказал, что использование императивных методов, когда значительное повышение производительности может быть реализовано, но спрятано функциональными интерфейсами, является одним из самых мощных методов, поощряемых в программировании на F #, в отличие от всей чистой культуры Haskell. Я впервые опубликовал эту реализацию на моем Project Euler для F # un blog, но повторно опубликую здесь, с исправленным кодом, замененным назад, и структурной типизацией удалено, primes может вычислить первые 100 000 простых чисел за 0.248 секунд и первые 1000 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)
    }

Ответ 8

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

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

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

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

• Оптимизации Ness от линейного сгибания дерева до двустороннего сгибания до многострочного сгибания и улучшения с использованием факторизации колес примерно так же эффективны для 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, а не в хвост поток zs. Соответственно, соответствующее время было исправлено, и примерно на 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 (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, включает время инициализации встроенных массивов таблиц поиска, время которых необходимо учитывать.

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

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

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

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

Ответ 9

Для чего это стоит, это не сито Эрафотена, а его очень быстрое:

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.2GHZ quadcore).

Ответ 10

На самом деле я пытался сделать то же самое, я сначала попробовал ту же наивную реализацию, что и в вопросе, но это было слишком медленно. Затем я нашел эту страницу YAPES: Problem Seven, Part 2, где он использовал реальное сито Эратосфена на основе Melissa E. ONeill. Я взял код оттуда, немного изменил его, потому что F # немного изменился после публикации.

let reinsert x table prime = 
   let comp = x+prime 
   match Map.tryFind comp table with 
   | None        -> table |> Map.add comp [prime] 
   | Some(facts) -> table |> Map.add comp (prime::facts) 

let rec sieve x table = 
  seq { 
    match Map.tryFind x table with 
    | None -> 
        yield x 
        yield! sieve (x+1I) (table |> Map.add (x*x) [x]) 
    | Some(factors) -> 
        yield! sieve (x+1I) (factors |> List.fold (reinsert x) (table |> Map.remove x)) } 

let primes = 
  sieve 2I Map.empty

primes |> Seq.takeWhile (fun elem -> elem < 2000000I) |> Seq.sum

Ответ 11

Я не думаю, что этот вопрос является полным только в отношении чисто функциональных алгоритмов, которые скрывают состояние в Map или Priority Queue в случае нескольких ответов или сложенного дерева слияния в случае одного из моих других ответов в что любой из них весьма ограничен в отношении удобства использования для больших диапазонов простых чисел из-за их приблизительной производительности O (n ^ 1,2) ('^' означает повышенную мощность, где n - верхнее число в последовательности), а также их вычислительные накладные расходы на операцию отсечения. Это означает, что даже для 32-разрядного диапазона чисел эти алгоритмы будут занимать около 10 минут, чтобы генерировать простые числа до четырех миллиардов плюс, что не очень удобно.

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

Следующий код был разработан после просмотра кода Jon Harrop и улучшает эти идеи следующим образом:

• Сбой кода Jon с точки зрения использования высокой памяти (сохраняет все сгенерированные простые числа вместо простых простых чисел в квадратный корень из старшего кандидата-кандидата и непрерывно регенерирует массивы буферов, когда-либо увеличивающиеся огромные размеры (равные размеру от последнего найденного штриха) независимо от размеров кэша ЦП.

• Кроме того, его код, представленный, не включает в себя последовательность генерации.

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

Если код Jon использовался для генерации диапазона простых чисел до 32-разрядного диапазона чисел в четыре миллиарда плюс, у него было бы требование к памяти для гигабайтов для сохраненных простых чисел в структуре списка и еще несколько гигабайт для сита буфера, хотя нет реальной причины, что последний не может иметь фиксированный меньший размер. После того, как размер ситового буфера превышает размер кеш-памяти процессора, производительность будет быстро ухудшаться при "переполнении кеша", с увеличением потери производительности, как и первый L1, затем L2 и, наконец, размеры L3 (если есть) превышены.

Именно поэтому код Jon будет вычислять простые числа до примерно 25 миллионов или даже даже на моей 64-разрядной машине с восемью гигабайтами памяти, прежде чем генерировать исключение из памяти, а также объясняет, почему существует больше и больше падение относительной производительности по мере того, как диапазоны становятся выше с производительностью O (n ^ 1.4) с увеличением диапазона и лишь немного сохранены, потому что у него такая низкая вычислительная сложность, чтобы начать с.

В следующем коде рассматриваются все эти ограничения, поскольку он только запоминает базовые простые числа до квадратного корня из максимального числа в диапазоне, который вычисляется по мере необходимости (только несколько килобайтов в случае 32-разрядного диапазон номеров) и использует только очень маленькие буферы размером около шестнадцати килобайт для каждого генератора базовых простых чисел и фильтров сит на главной странице (меньше размера кэша L1 для большинства современных процессоров), а также включает код генерирующей последовательности и ( в настоящее время) несколько оптимизированы только для просеивания для нечетных чисел, что означает, что память используется более эффективно. Кроме того, для повышения эффективности памяти используется массив упакованных бит; его стоимость вычислений в основном сводится к меньшему количеству вычислений, которые необходимо выполнить при сканировании буфера.

let primesAPF32() =
  let rec oddprimes() =
    let BUFSZ = 1<<<17 in let buf = Array.zeroCreate (BUFSZ>>>5) in let BUFRNG = uint32 BUFSZ<<<1
    let inline testbit i = (buf.[i >>> 5] &&& (1u <<< (i &&& 0x1F))) = 0u
    let inline cullbit i = let w = i >>> 5 in buf.[w] <- buf.[w] ||| (1u <<< (i &&& 0x1F))
    let inline cullp p s low = let rec cull' i = if i < BUFSZ then cullbit i; cull' (i + int p)
                               cull' (if s >= low then int((s - low) >>> 1)
                                      else let r = ((low - s) >>> 1) % p in if r = 0u then 0 else int(p - r))
    let inline cullpg low = //cull composites from whole buffer page for efficiency
      let max = low + BUFRNG - 1u in let max = if max < low then uint32(-1) else max
      let sqrtlm = uint32(sqrt(float max)) in let sqrtlmndx = int((sqrtlm - 3u) >>> 1)
      if low <= 3u then for i = 0 to sqrtlmndx do if testbit i then let p = uint32(i + i + 3) in cullp p (p * p) 3u
      else baseprimes |> Seq.skipWhile (fun p -> //force side effect of culling to limit of buffer
          let s = p * p in if p > 0xFFFFu || s > max then false else cullp p s low; true) |> Seq.nth 0 |> ignore
    let rec mkpi i low =
      if i >= BUFSZ then let nlow = low + BUFRNG in Array.fill buf 0 buf.Length 0u; cullpg nlow; mkpi 0 nlow
      else (if testbit i then i,low else mkpi (i + 1) low)
    cullpg 3u; Seq.unfold (fun (i,lw) -> //force cull the first buffer page then doit
        let ni,nlw = mkpi i lw in let p = nlw + (uint32 ni <<< 1)
        if p < lw then None else Some(p,(ni+1,nlw))) (0,3u)
  and baseprimes = oddprimes() |> Seq.cache
  seq { yield 2u; yield! oddprimes() }

primesAPF32() |> Seq.nth 203280220 |> printfn "%A"

Этот новый код вычисляет 203 280 221 простых чисел в 32-битном диапазоне чисел примерно в ADDED/CORRECTED: 25,4 секунды с временем работы для первых 100000, одного миллиона, 10 миллионов и 100 миллионов проверено как 0,01, 0,088, 0,94 и 11,25 секунды, соответственно на быстродействующем настольном компьютере (i7-2700K @3,5 ГГц) и может работать на tryfsharp.org и ideone.com, хотя в меньшем диапазоне для последнего из-за ограничений времени выполнения. Он имеет худшую производительность, чем код Jon Harrop для небольших диапазонов в несколько тысяч простых чисел из-за увеличения вычислительной сложности, но очень быстро передает его для больших диапазонов из-за его более эффективного алгоритма производительности, который компенсирует эту сложность, так что он примерно в пять раз быстрее для 10-миллионного премьер-плана и примерно в семь раз быстрее, чем до того, как код Джона взорвется примерно на 25-миллионный премьер.

Из общего времени выполнения более половины расходуется на перечисление базовой последовательности и, таким образом, в значительной степени не будет помогать, выполняя операции отбраковки составных чисел в качестве фоновых операций, хотя оптимизация факсимильной обработки в комбинации поможет ( хотя более интенсивно вычислить, эта сложность будет выполняться в фоновом режиме), поскольку они уменьшают количество операций проверки буфера, необходимых для перечисления. Дальнейшая оптимизация может быть выполнена, если порядок последовательностей не нужно сохранять (как при подсчете числа простых чисел или суммировании простых чисел), так как последовательности могут быть записаны для поддержки параллельных интерфейсов перечисления или код может быть написанный как класс, чтобы методы-члены могли выполнять вычисления без перечисления. Этот код может быть легко настроен на то, чтобы предлагать близкую к той же производительности, что и код С#, но более сжато выражен, хотя он никогда не достигнет производительности оптимизированного кода С++, такого как PrimeSieve, который был оптимизирован в первую очередь для задачи простого подсчета числа простых чисел по диапазону и может вычислять количество простых чисел в 32-битном диапазоне чисел - это небольшая часть секунды (0,25 секунд на i7-2700K).

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

И это в основном чистый функциональный код, просто он использует изменяемый массив для объединения композитного отбраковки....

Ответ 12

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

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

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

Так как О'Нил в своей статье на SoE с использованием инкрементных неограниченных сиверов в первую очередь показал, что силовое ядро ​​Turner не является равномерным как по алгоритму, так и по производительности, она не рассматривала многие другие варианты 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, или последовательности, поскольку memoization не требуется, а производительность лучше, также не использует Discriminated Unions и избегает сопоставления шаблонов по причинам производительности:

#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 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 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 }

Как указано, код медленнее, чем Tree Folding Wheel Optimized 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" начинаются менее плотные, они становятся более плотными, когда у приближается к нулю, а затем снова становится менее плотным; это означает, что последовательности вызова/возврата не сохраняются до минимальной глубины, как для SoE, но эта глубина увеличивается за пределами пропорциональности диапазону чисел. Решения, использующие фальцовку, не очень хороши, поскольку можно реализовать левую фальцовку для последовательностей, которые увеличивают плотность со временем, но все же оставляют отрицательные участки "3X" последовательностей плохо оптимизированными, как и нарушение последовательности "3X" в позитивные и отрицательные части. Самое простое решение, скорее всего, сохранит все последовательности на карте, что означает, что время доступа будет увеличиваться чем-то вроде журнала квадратного корня из диапазона, но это будет лучше для большего диапазона чисел, чем текущее сложение дерева. END_EDIT_ADD2

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

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

Ответ 13

Я не очень хорошо знаком с мультиплексами Haskell, но F # Power Pack имеет класс HashMultiMap, чья сводка xmldoc: "Хэш-таблицы, по умолчанию на основе структурных" хэш "и (=) функций F #. Таблица может отображать один ключ для нескольких привязок". Возможно, это может вам помочь?

Ответ 14

2 * 10 ^ 6 через 1 секунду на Corei5

let n = 2 * (pown 10 6)
let sieve = Array.append [|0;0|] [|2..n|]

let rec filterPrime p = 
    seq {for mul in (p*2)..p..n do 
            yield mul}
        |> Seq.iter (fun mul -> sieve.[mul] <- 0)

    let nextPrime = 
        seq { 
            for i in p+1..n do 
                if sieve.[i] <> 0 then 
                    yield sieve.[i]
        }
        |> Seq.tryHead

    match nextPrime with
        | None -> ()
        | Some np -> filterPrime np

filterPrime 2

let primes = sieve |> Seq.filter (fun x -> x <> 0)