Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
121
Task/Priority-queue/C-sharp/priority-queue-2.cs
Normal file
121
Task/Priority-queue/C-sharp/priority-queue-2.cs
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
namespace PriorityQ {
|
||||
using KeyT = UInt32;
|
||||
using System;
|
||||
using System.Collections.Generic;
|
||||
using System.Linq;
|
||||
class Tuple<K, V> { // for DotNet 3.5 without Tuple's
|
||||
public K Item1; public V Item2;
|
||||
public Tuple(K k, V v) { Item1 = k; Item2 = v; }
|
||||
public override string ToString() {
|
||||
return "(" + Item1.ToString() + ", " + Item2.ToString() + ")";
|
||||
}
|
||||
}
|
||||
class MinHeapPQ<V> {
|
||||
private struct HeapEntry {
|
||||
public KeyT k; public V v;
|
||||
public HeapEntry(KeyT k, V v) { this.k = k; this.v = v; }
|
||||
}
|
||||
private List<HeapEntry> pq;
|
||||
private MinHeapPQ() { this.pq = new List<HeapEntry>(); }
|
||||
private bool mt { get { return pq.Count == 0; } }
|
||||
private int sz {
|
||||
get {
|
||||
var cnt = pq.Count;
|
||||
return (cnt == 0) ? 0 : cnt - 1;
|
||||
}
|
||||
}
|
||||
private Tuple<KeyT, V> pkmn {
|
||||
get {
|
||||
if (pq.Count == 0) return null;
|
||||
else {
|
||||
var mn = pq[0];
|
||||
return new Tuple<KeyT, V>(mn.k, mn.v);
|
||||
}
|
||||
}
|
||||
}
|
||||
private void psh(KeyT k, V v) { // add extra very high item if none
|
||||
if (pq.Count == 0) pq.Add(new HeapEntry(UInt32.MaxValue, v));
|
||||
var i = pq.Count; pq.Add(pq[i - 1]); // copy bottom item...
|
||||
for (var ni = i >> 1; ni > 0; i >>= 1, ni >>= 1) {
|
||||
var t = pq[ni - 1];
|
||||
if (t.k > k) pq[i - 1] = t; else break;
|
||||
}
|
||||
pq[i - 1] = new HeapEntry(k, v);
|
||||
}
|
||||
private void siftdown(KeyT k, V v, int ndx) {
|
||||
var cnt = pq.Count - 1; var i = ndx;
|
||||
for (var ni = i + i + 1; ni < cnt; ni = ni + ni + 1) {
|
||||
var oi = i; var lk = pq[ni].k; var rk = pq[ni + 1].k;
|
||||
var nk = k;
|
||||
if (k > lk) { i = ni; nk = lk; }
|
||||
if (nk > rk) { ni += 1; i = ni; }
|
||||
if (i != oi) pq[oi] = pq[i]; else break;
|
||||
}
|
||||
pq[i] = new HeapEntry(k, v);
|
||||
}
|
||||
private void rplcmin(KeyT k, V v) {
|
||||
if (pq.Count > 1) siftdown(k, v, 0);
|
||||
}
|
||||
private void dltmin() {
|
||||
var lsti = pq.Count - 2;
|
||||
if (lsti <= 0) pq.Clear();
|
||||
else {
|
||||
var lkv = pq[lsti];
|
||||
pq.RemoveAt(lsti); siftdown(lkv.k, lkv.v, 0);
|
||||
}
|
||||
}
|
||||
private void reheap(int i) {
|
||||
var lfti = i + i + 1;
|
||||
if (lfti < sz) {
|
||||
var rghti = lfti + 1; reheap(lfti); reheap(rghti);
|
||||
var ckv = pq[i]; siftdown(ckv.k, ckv.v, i);
|
||||
}
|
||||
}
|
||||
private void bld(IEnumerable<Tuple<KeyT, V>> sq) {
|
||||
var sqm = from e in sq
|
||||
select new HeapEntry(e.Item1, e.Item2);
|
||||
pq = sqm.ToList<HeapEntry>();
|
||||
var sz = pq.Count;
|
||||
if (sz > 0) {
|
||||
var lkv = pq[sz - 1];
|
||||
pq.Add(new HeapEntry(KeyT.MaxValue, lkv.v));
|
||||
reheap(0);
|
||||
}
|
||||
}
|
||||
private IEnumerable<Tuple<KeyT, V>> sq() {
|
||||
return from e in pq
|
||||
where e.k != KeyT.MaxValue
|
||||
select new Tuple<KeyT, V>(e.k, e.v); }
|
||||
private void adj(Func<KeyT, V, Tuple<KeyT, V>> f) {
|
||||
var cnt = pq.Count - 1;
|
||||
for (var i = 0; i < cnt; ++i) {
|
||||
var e = pq[i];
|
||||
var r = f(e.k, e.v);
|
||||
pq[i] = new HeapEntry(r.Item1, r.Item2);
|
||||
}
|
||||
reheap(0);
|
||||
}
|
||||
public static MinHeapPQ<V> empty { get { return new MinHeapPQ<V>(); } }
|
||||
public static bool isEmpty(MinHeapPQ<V> pq) { return pq.mt; }
|
||||
public static int size(MinHeapPQ<V> pq) { return pq.sz; }
|
||||
public static Tuple<KeyT, V> peekMin(MinHeapPQ<V> pq) { return pq.pkmn; }
|
||||
public static MinHeapPQ<V> push(KeyT k, V v, MinHeapPQ<V> pq) {
|
||||
pq.psh(k, v); return pq; }
|
||||
public static MinHeapPQ<V> replaceMin(KeyT k, V v, MinHeapPQ<V> pq) {
|
||||
pq.rplcmin(k, v); return pq; }
|
||||
public static MinHeapPQ<V> deleteMin(MinHeapPQ<V> pq) { pq.dltmin(); return pq; }
|
||||
public static MinHeapPQ<V> merge(MinHeapPQ<V> pq1, MinHeapPQ<V> pq2) {
|
||||
return fromSeq(pq1.sq().Concat(pq2.sq())); }
|
||||
public static MinHeapPQ<V> adjust(Func<KeyT, V, Tuple<KeyT, V>> f, MinHeapPQ<V> pq) {
|
||||
pq.adj(f); return pq; }
|
||||
public static MinHeapPQ<V> fromSeq(IEnumerable<Tuple<KeyT, V>> sq) {
|
||||
var pq = new MinHeapPQ<V>(); pq.bld(sq); return pq; }
|
||||
public static Tuple<Tuple<KeyT, V>, MinHeapPQ<V>> popMin(MinHeapPQ<V> pq) {
|
||||
var rslt = pq.pkmn; if (rslt == null) return null;
|
||||
pq.dltmin(); return new Tuple<Tuple<KeyT, V>, MinHeapPQ<V>>(rslt, pq); }
|
||||
public static IEnumerable<Tuple<KeyT, V>> toSeq(MinHeapPQ<V> pq) {
|
||||
for (; !pq.mt; pq.dltmin()) yield return pq.pkmn; }
|
||||
public static IEnumerable<Tuple<KeyT, V>> sort(IEnumerable<Tuple<KeyT, V>> sq) {
|
||||
return toSeq(fromSeq(sq)); }
|
||||
}
|
||||
}
|
||||
23
Task/Priority-queue/C-sharp/priority-queue-3.cs
Normal file
23
Task/Priority-queue/C-sharp/priority-queue-3.cs
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
static void Main(string[] args) {
|
||||
Tuple<uint, string>[] ins = { new Tuple<uint,string>(3u, "Clear drains"),
|
||||
new Tuple<uint,string>(4u, "Feed cat"),
|
||||
new Tuple<uint,string>(5u, "Make tea"),
|
||||
new Tuple<uint,string>(1u, "Solve RC tasks"),
|
||||
new Tuple<uint,string>(2u, "Tax return") };
|
||||
|
||||
var spq = ins.Aggregate(MinHeapPQ<string>.empty, (pq, t) => MinHeapPQ<string>.push(t.Item1, t.Item2, pq));
|
||||
foreach (var e in MinHeapPQ<string>.toSeq(spq)) Console.WriteLine(e); Console.WriteLine();
|
||||
|
||||
foreach (var e in MinHeapPQ<string>.sort(ins)) Console.WriteLine(e); Console.WriteLine();
|
||||
|
||||
var npq = MinHeapPQ<string>.fromSeq(ins);
|
||||
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.merge(npq, npq)))
|
||||
Console.WriteLine(e); Console.WriteLine();
|
||||
|
||||
var npq = MinHeapPQ<string>.fromSeq(ins);
|
||||
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.merge(npq, npq)))
|
||||
Console.WriteLine(e);
|
||||
|
||||
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.adjust((k, v) => new Tuple<uint,string>(6u - k, v), npq)))
|
||||
Console.WriteLine(e); Console.WriteLine();
|
||||
}
|
||||
32
Task/Priority-queue/Common-Lisp/priority-queue.lisp
Normal file
32
Task/Priority-queue/Common-Lisp/priority-queue.lisp
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
;priority-queue's are implemented with association lists
|
||||
(defun make-pq (alist)
|
||||
(sort (copy-alist alist) (lambda (a b) (< (car a) (car b)))))
|
||||
;
|
||||
;Will change the state of pq
|
||||
;
|
||||
(define-modify-macro insert-pq (pair)
|
||||
(lambda (pq pair) (sort-alist (cons pair pq))))
|
||||
|
||||
(define-modify-macro remove-pq-aux () cdr)
|
||||
|
||||
(defmacro remove-pq (pq)
|
||||
`(let ((aux (copy-alist ,pq)))
|
||||
(REMOVE-PQ-AUX ,pq)
|
||||
(car aux)))
|
||||
;
|
||||
;Will not change the state of pq
|
||||
;
|
||||
(defun insert-pq-non-destructive (pair pq)
|
||||
(sort-alist (cons pair pq)))
|
||||
|
||||
(defun remove-pq-non-destructive (pq)
|
||||
(cdr pq))
|
||||
;testing
|
||||
(defparameter a (make-pq '((1 . "Solve RC tasks") (3 . "Clear drains") (2 . "Tax return") (5 . "Make tea"))))
|
||||
(format t "~a~&" a)
|
||||
(insert-pq a '(4 . "Feed cat"))
|
||||
(format t "~a~&" a)
|
||||
(format t "~a~&" (remove-pq a))
|
||||
(format t "~a~&" a)
|
||||
(format t "~a~&" (remove-pq a))
|
||||
(format t "~a~&" a)
|
||||
103
Task/Priority-queue/F-Sharp/priority-queue-1.fs
Normal file
103
Task/Priority-queue/F-Sharp/priority-queue-1.fs
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
[<RequireQualifiedAccess>]
|
||||
module PriorityQ =
|
||||
|
||||
// type 'a treeElement = Element of uint32 * 'a
|
||||
type 'a treeElement = struct val k:uint32 val v:'a new(k,v) = { k=k;v=v } end
|
||||
|
||||
type 'a tree = Node of uint32 * 'a treeElement * 'a tree list
|
||||
|
||||
type 'a heap = 'a tree list
|
||||
|
||||
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
|
||||
[<NoEquality; NoComparison>]
|
||||
type 'a outerheap = | HeapEmpty | HeapNotEmpty of 'a treeElement * 'a heap
|
||||
|
||||
let empty = HeapEmpty
|
||||
|
||||
let isEmpty = function | HeapEmpty -> true | _ -> false
|
||||
|
||||
let inline private rank (Node(r,_,_)) = r
|
||||
|
||||
let inline private root (Node(_,x,_)) = x
|
||||
|
||||
exception Empty_Heap
|
||||
|
||||
let peekMin = function | HeapEmpty -> None
|
||||
| HeapNotEmpty(min, _) -> Some (min.k, min.v)
|
||||
|
||||
let rec private findMin heap =
|
||||
match heap with | [] -> raise Empty_Heap //guarded so should never happen
|
||||
| [node] -> root node,[]
|
||||
| topnode::heap' ->
|
||||
let min,subheap = findMin heap' in let rtn = root topnode
|
||||
match subheap with
|
||||
| [] -> if rtn.k > min.k then min,[] else rtn,[]
|
||||
| minnode::heap'' ->
|
||||
let rmn = root minnode
|
||||
if rtn.k <= rmn.k then rtn,heap
|
||||
else rmn,minnode::topnode::heap''
|
||||
|
||||
let private mergeTree (Node(r,kv1,ts1) as tree1) (Node (_,kv2,ts2) as tree2) =
|
||||
if kv1.k > kv2.k then Node(r+1u,kv2,tree1::ts2)
|
||||
else Node(r+1u,kv1,tree2::ts1)
|
||||
|
||||
let rec private insTree (newnode: 'a tree) heap =
|
||||
match heap with
|
||||
| [] -> [newnode]
|
||||
| topnode::heap' -> if (rank newnode) < (rank topnode) then newnode::heap
|
||||
else insTree (mergeTree newnode topnode) heap'
|
||||
|
||||
let push k v = let kv = treeElement(k,v) in let nn = Node(0u,kv,[])
|
||||
function | HeapEmpty -> HeapNotEmpty(kv,[nn])
|
||||
| HeapNotEmpty(min,heap) -> let nmin = if k > min.k then min else kv
|
||||
HeapNotEmpty(nmin,insTree nn heap)
|
||||
|
||||
let rec private merge' heap1 heap2 = //doesn't guaranty minimum tree node as head!!!
|
||||
match heap1,heap2 with
|
||||
| _,[] -> heap1
|
||||
| [],_ -> heap2
|
||||
| topheap1::heap1',topheap2::heap2' ->
|
||||
match compare (rank topheap1) (rank topheap2) with
|
||||
| -1 -> topheap1::merge' heap1' heap2
|
||||
| 1 -> topheap2::merge' heap1 heap2'
|
||||
| _ -> insTree (mergeTree topheap1 topheap2) (merge' heap1' heap2')
|
||||
|
||||
let merge oheap1 oheap2 = match oheap1,oheap2 with
|
||||
| _,HeapEmpty -> oheap1
|
||||
| HeapEmpty,_ -> oheap2
|
||||
| HeapNotEmpty(min1,heap1),HeapNotEmpty(min2,heap2) ->
|
||||
let min = if min1.k > min2.k then min2 else min1
|
||||
HeapNotEmpty(min,merge' heap1 heap2)
|
||||
|
||||
let rec private removeMinTree = function
|
||||
| [] -> raise Empty_Heap // will never happen as already guarded
|
||||
| [node] -> node,[]
|
||||
| t::ts -> let t',ts' = removeMinTree ts
|
||||
if (root t).k <= (root t').k then t,ts else t',t::ts'
|
||||
|
||||
let deleteMin =
|
||||
function | HeapEmpty -> HeapEmpty
|
||||
| HeapNotEmpty(_,heap) ->
|
||||
match heap with
|
||||
| [] -> HeapEmpty // should never occur: non empty heap with no elements
|
||||
| [Node(_,_,heap')] -> match heap' with
|
||||
| [] -> HeapEmpty
|
||||
| _ -> let min,_ = findMin heap'
|
||||
HeapNotEmpty(min,heap')
|
||||
| _::_ -> let Node(_,_,ts1),ts2 = removeMinTree heap
|
||||
let nheap = merge' (List.rev ts1) ts2 in let min,_ = findMin nheap
|
||||
HeapNotEmpty(min,nheap)
|
||||
|
||||
let replaceMin k v pq = push k v (deleteMin pq)
|
||||
|
||||
let fromSeq sq = Seq.fold (fun pq (k, v) -> push k v pq) empty sq
|
||||
|
||||
let popMin pq = match peekMin pq with
|
||||
| None -> None
|
||||
| Some(kv) -> Some(kv, deleteMin pq)
|
||||
|
||||
let toSeq pq = Seq.unfold popMin pq
|
||||
|
||||
let sort sq = sq |> fromSeq |> toSeq
|
||||
|
||||
let adjust f pq = pq |> toSeq |> Seq.map (fun (k, v) -> f k v) |> fromSeq
|
||||
133
Task/Priority-queue/F-Sharp/priority-queue-2.fs
Normal file
133
Task/Priority-queue/F-Sharp/priority-queue-2.fs
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
[<RequireQualifiedAccess>]
|
||||
module PriorityQ =
|
||||
|
||||
type HeapEntry<'V> = struct val k:uint32 val v:'V new(k,v) = {k=k;v=v} end
|
||||
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
|
||||
[<NoEquality; NoComparison>]
|
||||
type PQ<'V> =
|
||||
| Mt
|
||||
| Br of HeapEntry<'V> * PQ<'V> * PQ<'V>
|
||||
|
||||
let empty = Mt
|
||||
|
||||
let isEmpty = function | Mt -> true
|
||||
| _ -> false
|
||||
|
||||
// Return number of elements in the priority queue.
|
||||
// /O(log(n)^2)/
|
||||
let rec size = function
|
||||
| Mt -> 0
|
||||
| Br(_, ll, rr) ->
|
||||
let n = size rr
|
||||
// rest n p q, where n = size ll, and size ll - size rr = 0 or 1
|
||||
// returns 1 + size ll - size rr.
|
||||
let rec rest n pl pr =
|
||||
match pl with
|
||||
| Mt -> 1
|
||||
| Br(_, pll, plr) ->
|
||||
match pr with
|
||||
| Mt -> 2
|
||||
| Br(_, prl, prr) ->
|
||||
let nm1 = n - 1 in let d = nm1 >>> 1
|
||||
if (nm1 &&& 1) = 0
|
||||
then rest d pll prl // subtree sizes: (d or d+1), d; d, d
|
||||
else rest d plr prr // subtree sizes: d+1, (d or d+1); d+1, d
|
||||
2 * n + rest n ll rr
|
||||
|
||||
let peekMin = function | Br(kv, _, _) -> Some(kv.k, kv.v)
|
||||
| _ -> None
|
||||
|
||||
let rec push wk wv =
|
||||
function | Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
|
||||
| Br(vkv, ll, rr) ->
|
||||
if wk <= vkv.k then
|
||||
Br(HeapEntry(wk, wv), push vkv.k vkv.v rr, ll)
|
||||
else Br(vkv, push wk wv rr, ll)
|
||||
|
||||
let inline private siftdown wk wv pql pqr =
|
||||
let rec sift pl pr =
|
||||
match pl with
|
||||
| Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
|
||||
| Br(vkvl, pll, plr) ->
|
||||
match pr with
|
||||
| Mt -> if wk <= vkvl.k then Br(HeapEntry(wk, wv), pl, Mt)
|
||||
else Br(vkvl, Br(HeapEntry(wk, wv), Mt, Mt), Mt)
|
||||
| Br(vkvr, prl, prr) ->
|
||||
if wk <= vkvl.k && wk <= vkvr.k then Br(HeapEntry(wk, wv), pl, pr)
|
||||
elif vkvl.k <= vkvr.k then Br(vkvl, sift pll plr, pr)
|
||||
else Br(vkvr, pl, sift prl prr)
|
||||
sift pql pqr
|
||||
|
||||
let replaceMin wk wv = function | Mt -> Mt
|
||||
| Br(_, ll, rr) -> siftdown wk wv ll rr
|
||||
|
||||
let deleteMin = function
|
||||
| Mt -> Mt
|
||||
| Br(_, ll, Mt) -> ll
|
||||
| Br(vkv, ll, rr) ->
|
||||
let rec leftrem = function | Mt -> vkv, Mt // should never happen
|
||||
| Br(kvd, Mt, _) -> kvd, Mt
|
||||
| Br(vkv, Br(kvd, _, _), Mt) ->
|
||||
kvd, Br(vkv, Mt, Mt)
|
||||
| Br(vkv, pl, pr) -> let kvd, pqd = leftrem pl
|
||||
kvd, Br(vkv, pr, pqd)
|
||||
let (kvd, pqd) = leftrem ll
|
||||
siftdown kvd.k kvd.v rr pqd;
|
||||
|
||||
let adjust f pq =
|
||||
let rec adj = function
|
||||
| Mt -> Mt
|
||||
| Br(vkv, ll, rr) -> let nk, nv = f vkv.k vkv.v
|
||||
siftdown nk nv (adj ll) (adj rr)
|
||||
adj pq
|
||||
|
||||
let fromSeq sq =
|
||||
if Seq.isEmpty sq then Mt
|
||||
else let nmrtr = sq.GetEnumerator()
|
||||
let rec build lvl = if lvl = 0 || not (nmrtr.MoveNext()) then Mt
|
||||
else let ck, cv = nmrtr.Current
|
||||
let lft = lvl >>> 1
|
||||
let rght = (lvl - 1) >>> 1
|
||||
siftdown ck cv (build lft) (build rght)
|
||||
build (sq |> Seq.length)
|
||||
|
||||
let merge (pq1:PQ<_>) (pq2:PQ<_>) = // merges without using a sequence
|
||||
match pq1 with
|
||||
| Mt -> pq2
|
||||
| _ ->
|
||||
match pq2 with
|
||||
| Mt -> pq1
|
||||
| _ ->
|
||||
let rec zipper lvl pq rest =
|
||||
if lvl = 0 then Mt, pq, rest else
|
||||
let lft = lvl >>> 1 in let rght = (lvl - 1) >>> 1
|
||||
match pq with
|
||||
| Mt ->
|
||||
match rest with
|
||||
| [] | Mt :: _ -> Mt, pq, [] // Mt in list never happens
|
||||
| Br(kv, ll, Mt) :: tl ->
|
||||
let pl, pql, rstl = zipper lft ll tl
|
||||
let pr, pqr, rstr = zipper rght pql rstl
|
||||
siftdown kv.k kv.v pl pr, pqr, rstr
|
||||
| Br(kv, ll, rr) :: tl ->
|
||||
let pl, pql, rstl = zipper lft ll (rr :: tl)
|
||||
let pr, pqr, rstr = zipper rght pql rstl
|
||||
siftdown kv.k kv.v pl pr, pqr, rstr
|
||||
| Br(kv, ll, Mt) ->
|
||||
let pl, pql, rstl = zipper lft ll rest
|
||||
let pr, pqr, rstr = zipper rght pql rstl
|
||||
siftdown kv.k kv.v pl pr, pqr, rstr
|
||||
| Br(kv, ll, rr) ->
|
||||
let pl, pql, rstl = zipper lft ll (rr :: rest)
|
||||
let pr, pqr, rstr = zipper rght pql rstl
|
||||
siftdown kv.k kv.v pl pr, pqr, rstr
|
||||
let sz = size pq1 + size pq2
|
||||
let pq, _, _ = zipper sz pq1 [pq2] in pq
|
||||
|
||||
let popMin pq = match peekMin pq with
|
||||
| None -> None
|
||||
| Some(kv) -> Some(kv, deleteMin pq)
|
||||
|
||||
let toSeq pq = Seq.unfold popMin pq
|
||||
|
||||
let sort sq = sq |> fromSeq |> toSeq
|
||||
84
Task/Priority-queue/F-Sharp/priority-queue-3.fs
Normal file
84
Task/Priority-queue/F-Sharp/priority-queue-3.fs
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
[<RequireQualifiedAccess>]
|
||||
module PriorityQ =
|
||||
|
||||
type HeapEntry<'T> = struct val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
|
||||
type MinHeapTree<'T> = ResizeArray<HeapEntry<'T>>
|
||||
|
||||
let empty<'T> = MinHeapTree<HeapEntry<'T>>()
|
||||
|
||||
let isEmpty (pq: MinHeapTree<_>) = pq.Count = 0
|
||||
|
||||
let size (pq: MinHeapTree<_>) = let cnt = pq.Count
|
||||
if cnt = 0 then 0 else cnt - 1
|
||||
|
||||
let peekMin (pq:MinHeapTree<_>) = if pq.Count > 1 then let kv = pq.[0]
|
||||
Some (kv.k, kv.v) else None
|
||||
|
||||
let push k v (pq:MinHeapTree<_>) =
|
||||
if pq.Count = 0 then pq.Add(HeapEntry(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] <- HeapEntry(k,v); pq
|
||||
|
||||
let inline private siftdown k v ndx (pq: MinHeapTree<_>) =
|
||||
let mutable i = ndx in let mutable ni = i in let cnt = pq.Count - 1
|
||||
while (ni <- ni + ni + 1; ni < cnt) do
|
||||
let lk = pq.[ni].k in let rk = pq.[ni + 1].k in let oi = i
|
||||
let k = if k > lk then i <- ni; lk else k in if k > rk then ni <- ni + 1; i <- ni
|
||||
if i <> oi then pq.[oi] <- pq.[i] else ni <- cnt //causes loop break
|
||||
pq.[i] <- HeapEntry(k,v)
|
||||
|
||||
let replaceMin k v (pq:MinHeapTree<_>) = siftdown k v 0 pq; pq
|
||||
|
||||
let deleteMin (pq:MinHeapTree<_>) =
|
||||
let lsti = pq.Count - 2
|
||||
if lsti <= 0 then pq.Clear(); pq else
|
||||
let lstkv = pq.[lsti]
|
||||
pq.RemoveAt(lsti)
|
||||
siftdown lstkv.k lstkv.v 0 pq; pq
|
||||
|
||||
let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then re-heapify
|
||||
let cnt = pq.Count - 1
|
||||
let rec adj i =
|
||||
let lefti = i + i + 1 in let righti = lefti + 1
|
||||
let ckv = pq.[i] in let (nk, nv) = f ckv.k ckv.v
|
||||
if righti < cnt then adj righti
|
||||
if lefti < cnt then adj lefti; siftdown nk nv i pq
|
||||
else pq.[i] <- HeapEntry(nk, nv)
|
||||
adj 0; pq
|
||||
|
||||
let fromSeq sq =
|
||||
if Seq.isEmpty sq then empty
|
||||
else let pq = new MinHeapTree<_>(sq |> Seq.map (fun (k, v) -> HeapEntry(k, v)))
|
||||
let sz = pq.Count in let lkv = pq.[sz - 1]
|
||||
pq.Add(HeapEntry(UInt32.MaxValue, lkv.v))
|
||||
let rec build i =
|
||||
let lefti = i + i + 1
|
||||
if lefti < sz then
|
||||
let righti = lefti + 1 in build lefti; build righti
|
||||
let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
|
||||
build 0; pq
|
||||
|
||||
let merge (pq1:MinHeapTree<_>) (pq2:MinHeapTree<_>) =
|
||||
if pq2.Count = 0 then pq1 else
|
||||
if pq1.Count = 0 then pq2 else
|
||||
let pq = empty
|
||||
pq.AddRange(pq1); pq.RemoveAt(pq.Count - 1)
|
||||
pq.AddRange(pq2)
|
||||
let sz = pq.Count - 1
|
||||
let rec build i =
|
||||
let lefti = i + i + 1
|
||||
if lefti < sz then
|
||||
let righti = lefti + 1 in build lefti; build righti
|
||||
let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
|
||||
build 0; pq
|
||||
|
||||
let popMin pq = match peekMin pq with
|
||||
| None -> None
|
||||
| Some(kv) -> Some(kv, deleteMin pq)
|
||||
|
||||
let toSeq pq = Seq.unfold popMin pq
|
||||
|
||||
let sort sq = sq |> fromSeq |> toSeq
|
||||
19
Task/Priority-queue/F-Sharp/priority-queue-4.fs
Normal file
19
Task/Priority-queue/F-Sharp/priority-queue-4.fs
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
> let testseq = [| (3u, "Clear drains");
|
||||
(4u, "Feed cat");
|
||||
(5u, "Make tea");
|
||||
(1u, "Solve RC tasks");
|
||||
(2u, "Tax return") |] |> Array.toSeq
|
||||
let testpq = testseq |> MinHeap.fromSeq
|
||||
testseq |> Seq.fold (fun pq (k, v) -> MinHeap.push k v pq) MinHeap.empty
|
||||
|> MinHeap.toSeq |> Seq.iter (printfn "%A") // test slow build
|
||||
printfn ""
|
||||
testseq |> MinHeap.fromSeq |> MinHeap.toSeq // test fast build
|
||||
|> Seq.iter (printfn "%A")
|
||||
printfn ""
|
||||
testseq |> MinHeap.sort |> Seq.iter (printfn "%A") // convenience function
|
||||
printfn ""
|
||||
MinHeap.merge testpq testpq // test merge
|
||||
|> MinHeap.toSeq |> Seq.iter (printfn "%A")
|
||||
printfn ""
|
||||
testpq |> MinHeap.adjust (fun k v -> uint32 (MinHeap.size testpq) - k, v)
|
||||
|> MinHeap.toSeq |> Seq.iter (printfn "%A") // test adjust;;
|
||||
|
|
@ -1,43 +1,3 @@
|
|||
data MinHeap a = Nil | MinHeap { v::a, cnt::Int, l::MinHeap a, r::MinHeap a }
|
||||
deriving (Show, Eq)
|
||||
import qualified Data.Set as S
|
||||
|
||||
hPush :: (Ord a) => a -> MinHeap a -> MinHeap a
|
||||
hPush x Nil = MinHeap {v = x, cnt = 1, l = Nil, r = Nil}
|
||||
hPush x h = if x < vv -- insert element, try to keep the tree balanced
|
||||
then if hLength (l h) <= hLength (r h)
|
||||
then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
|
||||
else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
|
||||
else if hLength (l h) <= hLength (r h)
|
||||
then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
|
||||
else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
|
||||
where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)
|
||||
|
||||
hPop :: (Ord a) => MinHeap a -> (a, MinHeap a)
|
||||
hPop h = (v h, pq) where -- just pop, heed not the tree balance
|
||||
pq | l h == Nil = r h
|
||||
| r h == Nil = l h
|
||||
| v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
|
||||
MinHeap {v = vv, cnt = hLength hh + hLength (r h),
|
||||
l = hh, r = r h}
|
||||
| otherwise = let (vv,hh) = hPop (r h) in
|
||||
MinHeap {v = vv, cnt = hLength hh + hLength (l h),
|
||||
l = l h, r = hh}
|
||||
|
||||
hLength :: (Ord a) => MinHeap a -> Int
|
||||
hLength Nil = 0
|
||||
hLength h = cnt h
|
||||
|
||||
hFromList :: (Ord a) => [a] -> MinHeap a
|
||||
hFromList = foldl (flip hPush) Nil
|
||||
|
||||
hToList :: (Ord a) => MinHeap a -> [a]
|
||||
hToList = unfoldr f where
|
||||
f Nil = Nothing
|
||||
f h = Just $ hPop h
|
||||
|
||||
main = mapM_ print $ hToList $ hFromList [
|
||||
(3, "Clear drains"),
|
||||
(4, "Feed cat"),
|
||||
(5, "Make tea"),
|
||||
(1, "Solve RC tasks"),
|
||||
(2, "Tax return")]
|
||||
main = print (S.toList (S.fromList [(3, "Clear drains"),(4, "Feed cat"),(5, "Make tea"),(1, "Solve RC tasks"), (2, "Tax return")]))
|
||||
|
|
|
|||
43
Task/Priority-queue/Haskell/priority-queue-3.hs
Normal file
43
Task/Priority-queue/Haskell/priority-queue-3.hs
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
data MinHeap a = Nil | MinHeap { v::a, cnt::Int, l::MinHeap a, r::MinHeap a }
|
||||
deriving (Show, Eq)
|
||||
|
||||
hPush :: (Ord a) => a -> MinHeap a -> MinHeap a
|
||||
hPush x Nil = MinHeap {v = x, cnt = 1, l = Nil, r = Nil}
|
||||
hPush x h = if x < vv -- insert element, try to keep the tree balanced
|
||||
then if hLength (l h) <= hLength (r h)
|
||||
then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
|
||||
else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
|
||||
else if hLength (l h) <= hLength (r h)
|
||||
then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
|
||||
else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
|
||||
where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)
|
||||
|
||||
hPop :: (Ord a) => MinHeap a -> (a, MinHeap a)
|
||||
hPop h = (v h, pq) where -- just pop, heed not the tree balance
|
||||
pq | l h == Nil = r h
|
||||
| r h == Nil = l h
|
||||
| v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
|
||||
MinHeap {v = vv, cnt = hLength hh + hLength (r h),
|
||||
l = hh, r = r h}
|
||||
| otherwise = let (vv,hh) = hPop (r h) in
|
||||
MinHeap {v = vv, cnt = hLength hh + hLength (l h),
|
||||
l = l h, r = hh}
|
||||
|
||||
hLength :: (Ord a) => MinHeap a -> Int
|
||||
hLength Nil = 0
|
||||
hLength h = cnt h
|
||||
|
||||
hFromList :: (Ord a) => [a] -> MinHeap a
|
||||
hFromList = foldl (flip hPush) Nil
|
||||
|
||||
hToList :: (Ord a) => MinHeap a -> [a]
|
||||
hToList = unfoldr f where
|
||||
f Nil = Nothing
|
||||
f h = Just $ hPop h
|
||||
|
||||
main = mapM_ print $ hToList $ hFromList [
|
||||
(3, "Clear drains"),
|
||||
(4, "Feed cat"),
|
||||
(5, "Make tea"),
|
||||
(1, "Solve RC tasks"),
|
||||
(2, "Tax return")]
|
||||
124
Task/Priority-queue/Haskell/priority-queue-4.hs
Normal file
124
Task/Priority-queue/Haskell/priority-queue-4.hs
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
data MinHeap kv = MinHeapEmpty
|
||||
| MinHeapLeaf !kv
|
||||
| MinHeapNode !kv {-# UNPACK #-} !Int !(MinHeap a) !(MinHeap a)
|
||||
deriving (Show, Eq)
|
||||
|
||||
emptyPQ :: MinHeap kv
|
||||
emptyPQ = MinHeapEmpty
|
||||
|
||||
isEmptyPQ :: PriorityQ kv -> Bool
|
||||
isEmptyPQ Mt = True
|
||||
isEmptyPQ _ = False
|
||||
|
||||
sizePQ :: (Ord kv) => MinHeap kv -> Int
|
||||
sizePQ MinHeapEmpty = 0
|
||||
sizePQ (MinHeapLeaf _) = 1
|
||||
sizePQ (MinHeapNode _ cnt _ _) = cnt
|
||||
|
||||
peekMinPQ :: MinHeap kv -> Maybe kv
|
||||
peekMinPQ MinHeapEmpty = Nothing
|
||||
peekMinPQ (MinHeapLeaf v) = Just v
|
||||
peekMinPQ (MinHeapNode v _ _ _) = Just v
|
||||
|
||||
pushPQ :: (Ord kv) => kv -> MinHeap kv -> MinHeap kv
|
||||
pushPQ kv pq = insert kv 0 pq where -- insert element, keeping the tree balanced
|
||||
insert kv _ MinHeapEmpty = MinHeapLeaf kv
|
||||
insert kv _ (MinHeapLeaf vv) = if kv <= vv
|
||||
then MinHeapNode kv 2 (MinHeapLeaf vv) MinHeapEmpty
|
||||
else MinHeapNode vv 2 (MinHeapLeaf kv) MinHeapEmpty
|
||||
insert kv msk (MinHeapNode vv cc ll rr) = if kv <= vv
|
||||
then if nmsk >= 0
|
||||
then MinHeapNode kv nc (insert vv nmsk ll) rr
|
||||
else MinHeapNode kv nc ll (insert vv nmsk rr)
|
||||
else if nmsk >= 0
|
||||
then MinHeapNode vv nc (insert kv nmsk ll) rr
|
||||
else MinHeapNode vv nc ll (insert kv nmsk rr)
|
||||
where nc = cc + 1
|
||||
nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to next
|
||||
else let s = floor $ (log $ fromIntegral nc) / log 2 in
|
||||
(nc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again
|
||||
|
||||
siftdown :: (Ord kv) => kv -> Int -> MinHeap kv -> MinHeap kv -> MinHeap kv
|
||||
siftdown kv cnt lft rght = replace cnt lft rght where
|
||||
replace cc ll rr = case rr of -- adj to put kv in current left/right
|
||||
MinHeapEmpty -> -- means left is a MinHeapLeaf
|
||||
case ll of { (MinHeapLeaf vl) ->
|
||||
if kv <= vl
|
||||
then MinHeapNode kv 2 ll MinHeapEmpty
|
||||
else MinHeapNode vl 2 (MinHeapLeaf kv) MinHeapEmpty }
|
||||
MinHeapLeaf vr ->
|
||||
case ll of
|
||||
MinHeapLeaf vl -> if vl <= vr
|
||||
then if kv <= vl then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vl cc (MinHeapLeaf kv) rr
|
||||
else if kv <= vr then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vr cc ll (MinHeapLeaf kv)
|
||||
MinHeapNode vl ccl lll rrl -> if vl <= vr
|
||||
then if kv <= vl then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vl cc (replace ccl lll rrl) rr
|
||||
else if kv <= vr then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vr cc ll (MinHeapLeaf kv)
|
||||
MinHeapNode vr ccr llr rrr -> case ll of
|
||||
(MinHeapNode vl ccl lll rrl) -> -- right is node, so is left
|
||||
if vl <= vr then
|
||||
if kv <= vl then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vl cc (replace ccl lll rrl) rr
|
||||
else if kv <= vr then MinHeapNode kv cc ll rr
|
||||
else MinHeapNode vr cc ll (replace ccr llr rrr)
|
||||
|
||||
replaceMinPQ :: (Ord kv) => a -> MinHeap kv -> MinHeap kv
|
||||
replaceMinPQ _ MinHeapEmpty = MinHeapEmpty
|
||||
replaceMinPQ kv (MinHeapLeaf _) = MinHeapLeaf kv
|
||||
replaceMinPQ kv (MinHeapNode _ cc ll rr) = siftdown kv cc ll rr where
|
||||
|
||||
deleteMinPQ :: (Ord kv) => MinHeap kv -> MinHeap kv
|
||||
deleteMinPQ MinHeapEmpty = MinHeapEmpty -- remove min keeping tree balanced
|
||||
deleteMinPQ pq = let (dkv, npq) = delete 0 pq in
|
||||
replaceMinPQ dkv npq where
|
||||
delete _ (MinHeapLeaf vv) = (vv, MinHeapEmpty)
|
||||
delete msk (MinHeapNode vv cc ll rr) =
|
||||
if rr == MinHeapEmpty -- means left is MinHeapLeaf
|
||||
then case ll of (MinHeapLeaf vl) -> (vl, MinHeapLeaf vv)
|
||||
else if nmsk >= 0 -- means only deal with left
|
||||
then let (dv, npq) = delete nmsk ll in
|
||||
(dv, MinHeapNode vv (cc - 1) npq rr)
|
||||
else let (dv, npq) = delete nmsk rr in
|
||||
(dv, MinHeapNode vv (cc - 1) ll npq)
|
||||
where nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to last
|
||||
else let s = floor $ (log $ fromIntegral cc) / log 2 in
|
||||
(cc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again
|
||||
|
||||
adjustPQ :: (Ord kv) => (kv -> kv) -> MinHeap kv -> MinHeap kv
|
||||
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
|
||||
adjust MinHeapEmpty = MinHeapEmpty
|
||||
adjust (MinHeapLeaf v) = MinHeapLeaf (f v)
|
||||
adjust (MinHeapNode vv cc ll rr) = siftdown (f vv) cc (adjust ll) (adjust rr)
|
||||
|
||||
fromListPQ :: (Ord kv) => [kv] -> MinHeap kv
|
||||
-- fromListPQ = foldl (flip pushPQ) MinHeapEmpty -- O(n log n) time; slow
|
||||
fromListPQ [] = MinHeapEmpty -- O(n) time using "adjust id" which is O(n)
|
||||
fromListPQ xs = let (_, pq) = build 1 xs in pq where
|
||||
sz = length xs
|
||||
szd2 = sz `div` 2
|
||||
build _ [] = ([], MinHeapEmpty)
|
||||
build lvl (x:xs') = if lvl > szd2 then (xs', MinHeapLeaf x)
|
||||
else let nlvl = lvl + lvl in
|
||||
let (xrl, pql) = build nlvl xs' in
|
||||
let (xrr, pqr) = if nlvl >= sz
|
||||
then (xrl, MinHeapEmpty) -- no right leaf
|
||||
else build (nlvl + 1) xrl in
|
||||
let cnt = sizePQ pql + sizePQ pqr + 1 in
|
||||
(xrr, siftdown x cnt pql pqr)
|
||||
|
||||
popMinPQ :: (Ord kv) => MinHeap kv -> Maybe (kv, MinHeap kv)
|
||||
popMinPQ pq = case peekMinPQ pq of
|
||||
Nothing -> Nothing
|
||||
Just v -> Just (v, deleteMinPQ pq)
|
||||
|
||||
toListPQ :: (Ord kv) => MinHeap kv -> [kv]
|
||||
toListPQ = unfoldr f where
|
||||
f MinHeapEmpty = Nothing
|
||||
f pq = popMinPQ pq
|
||||
|
||||
sortPQ :: (Ord kv) => [kv] -> [kv]
|
||||
sortPQ ls = toListPQ $ fromListPQ ls
|
||||
104
Task/Priority-queue/Haskell/priority-queue-5.hs
Normal file
104
Task/Priority-queue/Haskell/priority-queue-5.hs
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
data PriorityQ k v = Mt
|
||||
| Br !k v !(PriorityQ k v) !(PriorityQ k v)
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
emptyPQ :: PriorityQ k v
|
||||
emptyPQ = Mt
|
||||
|
||||
isEmptyPQ :: PriorityQ k v -> Bool
|
||||
isEmptyPQ Mt = True
|
||||
isEmptyPQ _ = False
|
||||
|
||||
-- The size function isn't from the ML code, but an implementation was
|
||||
-- suggested by Bertram Felgenhauer on Haskell Cafe, so it is included.
|
||||
|
||||
-- Return number of elements in the priority queue.
|
||||
-- /O(log(n)^2)/
|
||||
sizePQ :: PriorityQ k v -> Int
|
||||
sizePQ Mt = 0
|
||||
sizePQ (Br _ _ pl pr) = 2 * n + rest n pl pr where
|
||||
n = sizePQ pr
|
||||
-- rest n p q, where n = sizePQ q, and sizePQ p - sizePQ q = 0 or 1
|
||||
-- returns 1 + sizePQ p - sizePQ q.
|
||||
rest :: Int -> PriorityQ k v -> PriorityQ k v -> Int
|
||||
rest 0 Mt _ = 1
|
||||
rest 0 _ _ = 2
|
||||
rest n (Br _ _ ll lr) (Br _ _ rl rr) = case r of
|
||||
0 -> rest d ll rl -- subtree sizes: (d or d+1), d; d, d
|
||||
1 -> rest d lr rr -- subtree sizes: d+1, (d or d+1); d+1, d
|
||||
where m1 = n - 1
|
||||
d = m1 `shiftR` 1
|
||||
r = m1 .&. 1
|
||||
|
||||
peekMinPQ :: PriorityQ k v -> Maybe (k, v)
|
||||
peekMinPQ Mt = Nothing
|
||||
peekMinPQ (Br k v _ _) = Just (k, v)
|
||||
|
||||
pushPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
|
||||
pushPQ wk wv Mt = Br wk wv Mt Mt
|
||||
pushPQ wk wv (Br vk vv pl pr)
|
||||
| wk <= vk = Br wk wv (pushPQ vk vv pr) pl
|
||||
| otherwise = Br vk vv (pushPQ wk wv pr) pl
|
||||
|
||||
siftdown :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v -> PriorityQ k v
|
||||
siftdown wk wv Mt _ = Br wk wv Mt Mt
|
||||
siftdown wk wv (pl @ (Br vk vv _ _)) Mt
|
||||
| wk <= vk = Br wk wv pl Mt
|
||||
| otherwise = Br vk vv (Br wk wv Mt Mt) Mt
|
||||
siftdown wk wv (pl @ (Br vkl vvl pll plr)) (pr @ (Br vkr vvr prl prr))
|
||||
| wk <= vkl && wk <= vkr = Br wk wv pl pr
|
||||
| vkl <= vkr = Br vkl vvl (siftdown wk wv pll plr) pr
|
||||
| otherwise = Br vkr vvr pl (siftdown wk wv prl prr)
|
||||
|
||||
replaceMinPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
|
||||
replaceMinPQ wk wv Mt = Mt
|
||||
replaceMinPQ wk wv (Br _ _ pl pr) = siftdown wk wv pl pr
|
||||
|
||||
deleteMinPQ :: (Ord k) => PriorityQ k v -> PriorityQ k v
|
||||
deleteMinPQ Mt = Mt
|
||||
deleteMinPQ (Br _ _ pr Mt) = pr
|
||||
deleteMinPQ (Br _ _ pl pr) = let (k, v, npl) = leftrem pl in
|
||||
siftdown k v pr npl where
|
||||
leftrem (Br k v Mt Mt) = (k, v, Mt)
|
||||
leftrem (Br vk vv (Br k v _ _) Mt) = (k, v, Br vk vv Mt Mt)
|
||||
leftrem (Br vk vv pl pr) = let (k, v, npl) = leftrem pl in
|
||||
(k, v, Br vk vv pr npl)
|
||||
|
||||
-- the following function has been added to the ML code to apply a function
|
||||
-- to all the entries in the queue and reheapify in O(n) time
|
||||
adjustPQ :: (Ord k) => (k -> v -> (k, v)) -> PriorityQ k v -> PriorityQ k v
|
||||
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
|
||||
adjust Mt = Mt
|
||||
adjust (Br vk vv pl pr) = let (k, v) = f vk vv in
|
||||
siftdown k v (adjust pl) (adjust pr)
|
||||
|
||||
fromListPQ :: (Ord k) => [(k, v)] -> PriorityQ k v
|
||||
-- fromListPQ = foldl (flip pushPQ) Mt -- O(n log n) time; slow
|
||||
fromListPQ [] = Mt -- O(n) time using adjust-from-bottom which is O(n)
|
||||
fromListPQ xs = let (pq, _) = build (length xs) xs in pq where
|
||||
build 0 xs = (Mt, xs)
|
||||
build lvl ((k, v):xs') = let (pl, xrl) = build (lvl `shiftR` 1) xs'
|
||||
(pr, xrr) = build ((lvl - 1) `shiftR` 1) xrl in
|
||||
(siftdown k v pl pr, xrr)
|
||||
|
||||
-- the following function has been added to merge two queues in O(m + n) time
|
||||
-- where m and n are the sizes of the two queues
|
||||
mergePQ :: (Ord k) => PriorityQ k v -> PriorityQ k v -> PriorityQ k v
|
||||
mergePQ pq1 Mt = pq1 -- from concatenated "dumb" list
|
||||
mergePQ Mt pq2 = pq2 -- in O(m + n) time where m,n are sizes pq1,pq2
|
||||
mergePQ pq1 pq2 = fromListPQ (zipper pq1 $ zipper pq2 []) where
|
||||
zipper (Br wk wv Mt _) appndlst = (wk, wv) : appndlst
|
||||
zipper (Br wk wv pl Mt) appndlst = (wk, wv) : zipper pl appndlst
|
||||
zipper (Br wk wv pl pr) appndlst = (wk, wv) : zipper pl (zipper pr appndlst)
|
||||
|
||||
popMinPQ :: (Ord k) => PriorityQ k v -> Maybe ((k, v), PriorityQ k v)
|
||||
popMinPQ pq = case peekMinPQ pq of
|
||||
Nothing -> Nothing
|
||||
Just kv -> Just (kv, deleteMinPQ pq)
|
||||
|
||||
toListPQ :: (Ord k) => PriorityQ k v -> [(k, v)]
|
||||
toListPQ Mt = [] -- unfoldr popMinPQ
|
||||
toListPQ pq @ (Br vk vv _ _) = (vk, vv) : (toListPQ $ deleteMinPQ pq)
|
||||
|
||||
sortPQ :: (Ord k) => [(k, v)] -> [(k, v)]
|
||||
sortPQ ls = toListPQ $ fromListPQ ls
|
||||
18
Task/Priority-queue/Haskell/priority-queue-6.hs
Normal file
18
Task/Priority-queue/Haskell/priority-queue-6.hs
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
testList = [ (3, "Clear drains"),
|
||||
(4, "Feed cat"),
|
||||
(5, "Make tea"),
|
||||
(1, "Solve RC tasks"),
|
||||
(2, "Tax return") ]
|
||||
|
||||
testPQ = fromListPQ testList
|
||||
|
||||
main = do -- slow build
|
||||
mapM_ print $ toListPQ $ foldl (\pq (k, v) -> pushPQ k v pq) emptyPQ testList
|
||||
putStrLn "" -- fast build
|
||||
mapM_ print $ toListPQ $ fromListPQ testList
|
||||
putStrLn "" -- combined fast sort
|
||||
mapM_ print $ sortPQ testList
|
||||
putStrLn "" -- test merge
|
||||
mapM_ print $ toListPQ $ mergePQ testPQ testPQ
|
||||
putStrLn "" -- test adjust
|
||||
mapM_ print $ toListPQ $ adjustPQ (\x y -> (x * (-1), y)) testPQ
|
||||
19
Task/Priority-queue/Julia/priority-queue.julia
Normal file
19
Task/Priority-queue/Julia/priority-queue.julia
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
using Base.Collections
|
||||
|
||||
test = ["Clear drains" 3;
|
||||
"Feed cat" 4;
|
||||
"Make tea" 5;
|
||||
"Solve RC tasks" 1;
|
||||
"Tax return" 2]
|
||||
|
||||
task = PriorityQueue(Base.Order.Reverse)
|
||||
for i in 1:size(test)[1]
|
||||
enqueue!(task, test[i,1], test[i,2])
|
||||
end
|
||||
|
||||
println("Tasks, completed according to priority:")
|
||||
while !isempty(task)
|
||||
(t, p) = peek(task)
|
||||
dequeue!(task)
|
||||
println(" \"", t, "\" has priority ", p)
|
||||
end
|
||||
|
|
@ -12,7 +12,7 @@ let () =
|
|||
1, "Solve RC tasks";
|
||||
2, "Tax return";
|
||||
] in
|
||||
let pq = List.fold_right PQSet.add tasks PQSet.empty in
|
||||
let pq = PQSet.of_list tasks in
|
||||
let rec aux pq' =
|
||||
if not (PQSet.is_empty pq') then begin
|
||||
let prio, name as task = PQSet.min_elt pq' in
|
||||
|
|
|
|||
|
|
@ -1,14 +1,13 @@
|
|||
class PriorityQueue {
|
||||
has @!tasks is rw;
|
||||
has @!tasks;
|
||||
|
||||
method insert ( Int $priority where { $priority >= 0 }, $task ) {
|
||||
@!tasks[$priority] //= [];
|
||||
method insert (Int $priority where * >= 0, $task) {
|
||||
@!tasks[$priority].push: $task;
|
||||
}
|
||||
|
||||
method get { @!tasks.first({$^_}).shift }
|
||||
method get { @!tasks.first(?*).shift }
|
||||
|
||||
method is_empty { !?@!tasks.first({$^_}) }
|
||||
method is-empty { ?none @!tasks }
|
||||
}
|
||||
|
||||
my $pq = PriorityQueue.new;
|
||||
|
|
@ -26,4 +25,4 @@ for (
|
|||
$pq.insert( $priority, $task );
|
||||
}
|
||||
|
||||
say $pq.get until $pq.is_empty;
|
||||
say $pq.get until $pq.is-empty;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
PriorityQueue <- function() {
|
||||
keys <<- values <<- NULL
|
||||
keys <- values <- NULL
|
||||
insert <- function(key, value) {
|
||||
temp <- c(keys, key)
|
||||
ord <- order(temp)
|
||||
|
|
|
|||
42
Task/Priority-queue/REXX/priority-queue-2.rexx
Normal file
42
Task/Priority-queue/REXX/priority-queue-2.rexx
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
/*REXX pgm implements a priority queue; with insert/show/delete top task*/
|
||||
n=0
|
||||
task.=0 /* for the sake of task.0done.* */
|
||||
say '------ inserting tasks.'; call ins_task 3 'Clear drains'
|
||||
call ins_task 4 'Feed cat'
|
||||
call ins_task 5 'Make tea'
|
||||
call ins_task 1 'Solve RC tasks'
|
||||
call ins_task 2 'Tax return'
|
||||
call ins_task 6 'Relax'
|
||||
call ins_task 6 'Enjoy'
|
||||
say '------ Showing tasks.'; call show_tasks
|
||||
say '------ Show and delete top task.'
|
||||
todo=n /* tasks to be done */
|
||||
do While todo>0
|
||||
Say top()
|
||||
End
|
||||
exit
|
||||
|
||||
ins_task: procedure expose n task.
|
||||
n=n+1
|
||||
Parse Arg task.0pri.n task.0txt.n
|
||||
Return
|
||||
|
||||
show_tasks: procedure expose task. n
|
||||
do i=1 To n
|
||||
Say task.0pri.i task.0txt.i
|
||||
End
|
||||
Return
|
||||
|
||||
top: procedure expose n task. todo /* get top task and mark it 'done' */
|
||||
high=0
|
||||
Do i=1 To n
|
||||
If task.0pri.i>high &,
|
||||
task.0done.i=0 Then Do
|
||||
j=i
|
||||
high=task.0pri.i
|
||||
End
|
||||
End
|
||||
res=task.0pri.j task.0txt.j
|
||||
task.0done.j=1
|
||||
todo=todo-1
|
||||
return res
|
||||
Loading…
Add table
Add a link
Reference in a new issue