ノート:ヒープソート

ページのコンテンツが他言語でサポートされていません。

加筆依頼が出ていたので、例と擬似コードを追加してみましたが正直あまり上手い説明かどうかは自信ありません。このような形でよろしいでしょうか。--U-ichi 2006年8月25日 (金) 02:30 (UTC)[返信]

加筆ありがとうございます。--Kenpei 2006年8月25日 (金) 14:05 (UTC)[返信]
加筆ありがとうございます。ただ、私が記述していたアルゴリズムとは、少しだけ違う実装ですね(特に前半のヒープ構築部分で、再帰呼び出しを使っているあたり)。どちらかに統一した方が良いと思いますが、皆さんのご意見をいただけないでしょうか。ちなみに私は アニメーションによる説明 を作っていました。初めての Animation GIF で時間がかかってしまいましたが。--Nagae 2006年8月26日 (土) 03:14 (UTC)[返信]
Kenpeiさん、Nagaeさん、早速の返信ありがとうございます。アルゴリズムの実装方法の統一についてですがNagaeさんの作成したアニメーションを拝見させていただきました、僕としては(加筆依頼を見ただけの通りすがりですから)Nagaeさんの実装の方に統一してもらってもかまわないと思います。最も生成されるヒープ木は同じ形ですから同じアルゴリズムの再帰版と非再帰版の違いだと思います。この辺りの実装の違いをヒープの方で詳しく記述して、例の実装を箇条書きしている部分を、ヒープ木の生成にはいくつかの実装があることを簡単に触れた上で「ここでは~の実装で行う」みたいな形に変更してより詳しくはヒープ参照とすれば良いかと、アニメーションは一通り説明を終えてから「まとめると全行程はこのようになる」という風に掲載すればわかりやすいかと思います。擬似コードは実装に合わせて書き直せばよいかと。--U-ichi 2006年8月28日 (月) 08:27 (UTC)[返信]

スムースソート(smoothsort)のサンプルコード[編集]

英語版記事(Heapsort 00:39, 29 April 2008)の Variations で紹介されている smoothsort algorithm[1] ですが、1981年の論文のためか、使われている擬似コードがCでのマクロ展開を前提としている様で、変数のスコープが不明瞭です。 そこで、OCamlに翻訳したサンプルを作成してみました。

(* treat structure of Leonardo Numbers *)
let getB (bx, _) = bx
let getC (_, cx) = cx
let up (bx, cx) = (bx + cx + 1, bx)
let down (bx, cx) = (cx, bx - cx - 1)

(* swap *)
let swap m i j =
  let t = m.(i) in
  m.(i) <- m.(j);
  m.(j) <- t

(* sift *)
let sift m r bc =
  let r1 = ref r in 
  let bc1 = ref bc in 
  while (getB !bc1) >= 3 do
    let r2 = !r1 - (getB !bc1) + (getC !bc1) in 
    let r21 =
      if m.(r2) >= m.(!r1 - 1) then r2
      else begin
       bc1 := down !bc1; !r1 - 1
      end
    in
    if m.(!r1) >= m.(r21) then bc1 := (1, getC !bc1)
    else begin
      swap m !r1 r21; r1 := r21; bc1 := down !bc1
    end
  done

(* trinkle *)
let trinkle m r p bc =
  let (p1, r1) = (ref p, ref r)
  and bc1 = ref bc in
  while !p1 > 0 do
    let r3 =
      while !p1 mod 2 = 0 do
        p1 := !p1 / 2; bc1 := up !bc1
      done; !r1 - (getB !bc1)
    in
    if !p1 = 1 or m.(r3) <= m.(!r1) then p1 := 0
    else begin
      p1 := !p1 - 1;
      if (getB !bc1) = 1 then begin
        swap m !r1 r3; r1 := r3
      end else begin (* b >= 3 *)
        let r2 = !r1 - (getB !bc1) + (getC !bc1) in 
        let r21 =
          if m.(r2) >= m.(!r1 - 1) then r2
          else begin 
            bc1 := down !bc1; p1 := 2 * !p1; !r1 - 1
          end
        in
        if m.(r3) >= m.(r21) then begin
          swap m !r1 r3; r1 := r3
        end else begin
          swap m !r1 r21; r1 := r21; bc1 := down !bc1; p1 := 0
        end
      end
    end
  done; sift m !r1 !bc1

(* semitrinkle *)
let semitrinkle m r p bc =
  let r1 = r - (getC bc) in
  if m.(r1) > m.(r) then begin
    swap m r r1;
    trinkle m r1 p bc
  end

(* the main routine of smoothsort *)
let smoothsort m =
  let _N = Array.length m in
  let (q,  r) = (ref 1, ref 0)
  and (p, bc) = (ref 1, ref (1, 1)) in (* invariant: P3' and P4'  *)
  while !q < _N do
    if !p mod 8 = 3 then begin
      sift m !r !bc;
      p := (!p + 1) / 4; bc := up (up !bc)
    end else if !p mod 4 = 1 then begin
      if !q + (getC !bc) < _N then sift m !r !bc
      else trinkle m !r !p !bc ;
      bc := down !bc; p := 2 * !p;
      while (getB !bc) > 1 do
        bc := down !bc; p := 2 * !p;
      done;
      p := !p + 1
    end;
    q := !q + 1; r := !r + 1
  done (* P3' and P4' *);
  trinkle m !r !p !bc ; (* invariant: P3 and P4 *)
  while !q > 1 do
    q := !q - 1; 
    if (getB !bc) = 1 then begin
      r := !r - 1; p := !p - 1;
      while !p mod 2 = 0 do
        p := !p / 2; bc := up !bc
      done
    end else begin (* asset (b >= 3) *)
      p := !p - 1; r := !r - (getB !bc) + (getC !bc);
      if !p > 0 then semitrinkle m !r !p !bc;
      bc := down !bc; p := 2 * !p + 1;
      r := !r + (getC !bc); semitrinkle m !r !p !bc;
      bc := down !bc; p := 2 * !p + 1
    end
  done

--Shigenori TSUNEZAWA 2008年5月2日 (金) 07:51 (UTC)[返信]