100までの整数から素数を列挙せよ…を bitblt で


bitblt というのは、bit-boundary block transfer(bit-field とも)の略で、その名の通り、画像表示処理などの際に行なうビットブロック転送操作、あるいはその実装を指します。BitBlt、あるいは、BitBLT とも(Smalltalk のクラス名としては BitBlt)。もともとは、ALTO の世界初とも言われるモダンで本格的な GUI の担い手である Smalltalk システムにおいて、マルチフォントなテキスト表示や、オーバーラップして一部しか見えていないウインドウ内容を更新する際などに大いに活用されていました(いや…、います。w)。それが Smalltalk 発だということが、意外と知られていないものの一つでもありますね。


Squeak システムで、エンドユーザーに身近な BitBlt クラスの活用例は、タートルグラフィックスです。LOGO の影響を強く受けて作られた Smaltallk システムは、ALTO に移植されてすぐにタートルグラフィックス機能が実装されました( Smalltalk-72 の初期のウインドウの描画には、このタートル描画がさっそく使われています)。Smalltalk のタートルには Pen のインスタンスが用いられていて、Squeak システムの場合、クラス Pen は、クラス BitBlt のサブクラスとして定義されています(ちょ、現在主流の“オブジェクト指向”的には、NGとされる典型的な継承関係…(^_^;))。

ProtoObject
   Object
      BitBlt
         Pen
            PenPointRecorder


ペンは、たとえば、こんなふうにして使えます。

| pen |
pen := Pen new.
pen roundNib: 8.
pen color: Color red.
[Sensor leftShiftDown] whileFalse: [
   | pt |
   pt := Sensor cursorPoint.
   Sensor redButtonPressed ifTrue: [pen goto: pt] ifFalse: [pen place: pt]]


まず手始めに、このペンを使って、画面にドットを打つことでエラトステネスの篩を描いてみます。

| limit sqrt area pen pixelOf eraseAt black primes checkOn |

limit := 40000.
primes := #() writeStream.

sqrt := limit sqrt ceiling.
area := Rectangle center: Display center extent: sqrt.
black := Color black.
Display fillWhite; fill: area fillColor: black.
pen := Pen new defaultNib: 1; color: Color white.

pixelOf := [:n1 | (n1 \\ sqrt) @ (n1 // sqrt) + area topLeft].
eraseAt := [:n2 | pen place: (pixelOf value: n2); go: 0].
checkOn := [:n3 | (Display colorAt: (pixelOf value: n3)) = black].

eraseAt value: 1.
2 to: sqrt do: [:nn |
   (checkOn value: nn) ifTrue: [
      primes nextPut: nn].
      (nn*2 to: limit by: nn) do: [:mm | eraseAt value: mm]].
sqrt+1 to: limit by: 2 do: [:nn | (checkOn value: nn) ifTrue: [primes nextPut: nn]].

Display flash: area. (Delay forSeconds: 1) wait. Display restore.

^ primes size

実行の様子の QuckTime ムービーはこちら。


ただ、これではあまりに遅いですし、なにより bitblt のキモであるビットのブロック転送というのがまったく活かされていません。そこで、

  1. 指定矩形内における素数の倍数の出現パターンを抽出
  2. それを敷き詰めた一斉消去用のパターンを作成

し、その画像を重ねてゆくことで、もう少し効率的に篩を完成させることにします。

| limit sqrt area pixelOf black primes checkOn eraserOf |

limit := 40000.
primes := #() writeStream.

sqrt := limit sqrt ceiling.
area := Rectangle origin: 0@0 extent: sqrt@sqrt.
black := Color black.

Display fillWhite; fill: area fillColor: black.

pixelOf := [:n1 | (n1 \\ sqrt) @ (n1 // sqrt) + area topLeft].
checkOn := [:n3 | (Display colorAt: (pixelOf value: n3)) = black].
eraserOf := [:n4 |
   | delta height pattern eraser |
   delta := (sqrt alignedTo: n4) \\ sqrt.
   height := delta = 0 ifTrue: [1] ifFalse: [n4].
   pattern := Form extent: n4 @ height depth: 1.
   1 to: height do: [:yy | pattern colorAt: yy-1 * delta \\ n4 @ (yy-1) put: black].
   eraser := Form extent: sqrt asPoint depth: 1.
   (InfiniteForm with: pattern) displayOn: eraser.
   eraser].

2 to: sqrt do: [:nn |
   (checkOn value: nn) ifTrue: [
      | bb |
      primes nextPut: nn.
      bb := BitBlt
         destForm: Display
         sourceForm: (eraserOf value: nn)
         fillColor: Color white
         combinationRule: Form under
         destOrigin: area origin
         sourceOrigin: area origin
         extent: area extent
         clipRect: area.
      bb colorMap: (Bitmap with: 0 with: 16rFFFFFFFF).
      bb copyBits]].
sqrt+1 to: limit by: 2 do: [:nn | (checkOn value: nn) ifTrue: [primes nextPut: nn]].

Display flash: area. (Delay forSeconds: 1) wait. Display restore.

^ primes size

実行の様子の QuckTime ムービーはこちら。


かなりマシになりました。コードももう少し整理できるはずなのですが、締め切りも過ぎ、マイブームも去ってしまったので、問題解決の可能性の検証だけで終わりにします。あしからず。


今回はディスプレイ(グローバル変数 Display に代入されている DisplayScreen のインスタンス)を使っているため、短辺のドット数の自乗の数までしか素数を求めることができません。もっとも、篩ができあがってゆく過程を見せる必要もないので、Display を使わずにフレームバッファのみで処理を行なえば、もっと大きな数まで、かつ、高速な処理も可能でしょう。


関連: