ノート:ヒープソート

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

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

message: 英語版記事(Heapsort 00:39, 29 April 2008)の Variations で紹介されている
smoothsort algorithm
ですが、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)
thread_title:  スムースソート(smoothsort)のサンプルコード