module type RESIZABLEARRAY_SIG =
    sig
      type 'a t
      val create : unit -> 'a t
      val is_empty : 'a t -> bool
      val length : 'a t -> int
      val get : 'a t -> int -> 'a
      val set : 'a t -> int -> 'a -> unit
      val add : 'a t -> 'a -> unit
      exception ResizableArray_is_empty
      val pop : 'a t -> 'a 
    end;;

module ResizableArray = (
  (* une structure de tableau redimensionnable *)
  struct
    type 'a t = {mutable nb: int ; mutable cp: int ; mutable elem: 'a array}
    let create () = {nb = 0; cp = 0; elem = [| |]}
    let is_empty a = a.nb = 0
    let length a = a.nb 
    let get a i = a.elem.(i)
    let set a i x = a.elem.(i) <- x
    let add a x = match a.nb = a.cp with
      | true -> let e2=Array.make (2*a.cp + 1) x in
		for i=0 to a.nb - 1 do
		  e2.(i) <- a.elem.(i)
		done ;
		a.nb <- a.nb + 1 ;
		a.cp <- 2*a.cp + 1 ;
		a.elem <- e2 
      | false -> a.elem.(a.nb) <- x ; a.nb <- a.nb + 1
    exception ResizableArray_is_empty
    let pop a = match a.nb with
      | 0 -> raise ResizableArray_is_empty
      | _ -> a.nb <- a.nb - 1 ; a.elem.(a.nb)
  end : RESIZABLEARRAY_SIG)
;;


 module type PRIOQUEUE_SIG =
    sig
      type 'a t
      val create : unit -> 'a t
      val is_empty : 'a t -> bool
      exception PrioQueue_is_empty
      exception AlreadyMemberInPrioQueue
      exception NotMemberInPrioQueue
      val add : 'a t -> 'a -> int -> unit
      val remove_prio : 'a t -> 'a
      val change_prio : 'a t -> 'a -> int -> unit
      val mem : 'a t -> 'a -> bool
      end;;


module PrioQueue = (
  (* file de priorite min *)
  struct
    type 'a t = {tr: (int * 'a) ResizableArray.t ; pos: ('a, int) Hashtbl.t}
    let create () = {tr = ResizableArray.create () ; pos = Hashtbl.create 0}
    let is_empty f=ResizableArray.is_empty f.tr
    let fg i = 2*i+1 and fd i = 2*i+2 and pere i = (i-1)/2
    let echanger t i j h=
      (* t tableau f.tr, h la table de hachage f.pos *)
      (* echange les elements d'indice i et j de t et met a jour les positions dans la table de hachage *)
      let a=ResizableArray.get t i in ResizableArray.set t i (ResizableArray.get t j) ; ResizableArray.set t j a ;
      Hashtbl.replace h (snd (ResizableArray.get t i)) i ;
      Hashtbl.replace h (snd (ResizableArray.get t j)) j
    let monter t i h =
      (* t: le tableau redimensionnable f.tr, h la table de hachage *)
      (* les elements sont compares suivant l'ordre lexicographique, donc sur la priorite *)
      let j=ref i in
      while !j>0 && ResizableArray.get t !j < ResizableArray.get t (pere !j) do
	echanger t !j (pere !j) h;
	j:=pere !j
      done
    let rec descendre t i h =
      let n=ResizableArray.length t in
      (* t: le tableau elem dans le tableau redimensionnable f.tr, h la table de hachage, n le nombre d'elements dans la fp (donc interessant dans t) *)
      let imax=ref i in
      if fg i < n && ResizableArray.get t (fg i) < ResizableArray.get t i then imax := fg i ;
      if fd i < n && ResizableArray.get t (fd i) < ResizableArray.get t !imax then imax :=fd i ;
      if !imax <> i then begin
	echanger t i !imax h;
	descendre t !imax h
      end
    exception PrioQueue_is_empty
    exception AlreadyMemberInPrioQueue
    exception NotMemberInPrioQueue
    let add f x p =
      (* ajoute avec priorite p l'element x. x ne doit pas etre deja present *)
      if Hashtbl.mem f.pos x then raise AlreadyMemberInPrioQueue
      else begin
	ResizableArray.add f.tr (p,x) ;
	Hashtbl.add f.pos x (ResizableArray.length f.tr - 1) ;
	monter f.tr (ResizableArray.length f.tr - 1) f.pos
      end
    let remove_prio f =
      if is_empty f then raise PrioQueue_is_empty else
	begin
	  let n=ResizableArray.length f.tr in
	  echanger f.tr 0 (n-1) f.pos ;
	  let _,x=ResizableArray.pop f.tr in
	  Hashtbl.remove f.pos x ;
	  if n>1 then descendre f.tr 0 f.pos ;
	  x
	end
    let change_prio f x p=
      (* on modifie la priorite de l'élément x (en general on baisse l'entier, c'est à dire que l'élément doit remonter dans le tableau, mais l'inverse est possible) *)
      if not (Hashtbl.mem f.pos x) then raise NotMemberInPrioQueue ;
      let i=Hashtbl.find f.pos x in
      let pprev = fst (ResizableArray.get f.tr i) in
      ResizableArray.set f.tr i (p,x) ;
      if pprev > p then monter f.tr i f.pos else descendre f.tr i f.pos
    let mem f x=Hashtbl.mem f.pos x
  end : PRIOQUEUE_SIG)
;;

(* Utilisation : *)

(* let elem, prio = [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11|], [|8; 5; 7; 9; 2; 0; 4; 15; 6; 3; 2; 10|] ;;
 * 	  
 * 	  
 * let f = PrioQueue.create () ;;
 * for i=0 to 11 do
 *   PrioQueue.add f elem.(i) prio.(i)
 * done ;;
 * PrioQueue.change_prio f 11 (-1) ;;
 * PrioQueue.change_prio f 0 (10) ;;
 * PrioQueue.change_prio f 5 (4) ;;
 * f ;;
 * for i=0 to 11 do
 *   print_int (PrioQueue.remove_prio f) ;
 *   print_string " "
 * done ;; *)