Simple Scheme で電卓をつくってみる(13.5)
×=等の機能をいれる前は=ボタンは演算ボタンと似たようなもの―というよりは=ボタンはget2ndと結びつけられた演算ボタンでした。
別扱いにしていたのはいずれ異なる機能を持つことがわかっていたからです。
んで、=ボタン用の関数は他の演算ボタンと同じようにmake-op*1で生成していました。
つまり=ボタンの機能は演算ボタン用の関数内で実装していたわけです。
そして+=、-=、×=、÷=の機能をいれたときも元々あった処理は演算ボタン用の関数内に残して=用の関数から呼び出すようにし、新たな機能のみ=用の関数内に直接書いたのでした。
しかし、これは役割分担のし方としては少し複雑なので次のように変えます。
- =ボタン用の関数: 最後に指定された演算を実行する
- 演算ボタン用の関数: 次に行う演算を指定する
そして演算ボタンで演算を実行する必要がある場合は演算ボタン用の関数から=ボタン用の関数を呼び出すようにします。
(define (make-op-func i) (lambda () (and (symbol=? error-type nothing) (begin (or (symbol=? mode waiting) (input=)) (or (symbol=? error-type non-recov) (set! op-no i)))))) (define (input=) (and (symbol=? error-type nothing) (begin (and (symbol=? mode waiting) (set! input result)) (set! result ((list-ref ops op-no) result input)) (check-overflow!) (set! window result) (set! op-no 0) (set! mode waiting))))
続きます。
*1:opはaddとかsubとかを指すのに使っている名前で、この関数はaddとかsubとかを作らないので今している変更のついでにmake-op-funcに名前を変えました。
Simple Scheme で電卓をつくってみる(13) ― メモリ機能 ―
メモリーキーを実装します。
右端にあるM+、M-、MRの3つのボタンですね。
メモリーキーは計算結果を保存し、あとで取り出せるようにするボタンです*1。
というわけでまず保存内容を保持する変数を用意します（というかすでにmemoryという名前で大分前から用意してあります）。
(define-struct num (sign i f)) (define plus "") (define minus "-") (define zero (make-num plus '(0) '())) (define input zero) (define window input) (define result zero) (define memory zero)
memoryの初期値は0ですね。M+を押すと、memoryに計算結果が加算されます（memoryがバインドしている値と計算結果とを足し合わせた値がmemoryに代入されます）。
例えば 3 M+ × 4 = M+ と打つと、最初のM+で3が加算されmemoryの値は3になり、次のM+で3×4が加算されmemoryの値は15になります。
計算が途中のときは計算を終わらせてから加算されます。つまり電卓は、M+が押されたとき、まず=が押されたときと同じ挙動をし、それからmemoryへの加算を実行します。だから上の例で最後のM+の前の=がなくても電卓の最終的な状態は完全に同じです。最初に3を押したときも計算の途中（数値の入力の途中）であるとみなせますが、これもちゃんと保存されます*2。
M-を押すと、memoryから計算結果が減算されます*3。
例えば 3 M+ × 4 = M- と打つと、最初のM+で3が加算されmemoryの値が3になり、次のM-で3×4が引かれmemoryの値が-9になります。
M+やM-が押されたときに起動する関数を、上記のような挙動をするように定義しましょう。関数は2つになりますが、メモリに結果を足すか引くか以外に違いがないので、生成関数を作って違う部分だけparameterizeすることにします。
(define (make-m-func op) (lambda () (begin (input=) (and (symbol=? error-type nothing) (let ((x (op memory result))) (if (> (length (num-i x)) max-ndigits) (begin (set! error-type non-recov) (set! result zero)) (set! memory x)))))))
make-m-funcにaddかsubを渡すとボタンに反応する関数が生成されます。addを渡して生成される関数がM+ボタンを押したときに起動する関数であり、subを渡して生成される関数がM-ボタンを押したときに起動する関数です。
計算結果をmemoryに足すときやmemoryから引くときに桁溢れすることがあります*4。この桁溢れは他の桁溢れと扱いを変えて、エラーを通知しつつディスプレイに0を表示して、メモリの内容は変更しないことにしました*5。
そうするとerror-typeはoverflowではなくdivide-by-0ということになりますが、0割りは起こってないので紛らわしいですね。で、エラーの名前を変えました。リカバーされないエラーなのでnon-recovとします。また、overflowはrecovに変えます。*6
(define (inputMR) (and (symbol=? error-type nothing) (begin (set! input memory) (set! mode inputted) (set! window input))))
MRを押すとmemoryがinput（とwindow）に代入されます。つまり電卓はMRが押されるとmemoryの値が入力されたような挙動を取るわけです。
だからといってモードはinputtingにするわけにはいきません。inputtingだと続けて数字を入力したとききに、inputがmemoryの右に入力した数字をくっつけた数になってしまいます*7。
かといってwaitingにもできません。inputにコピー*8されたmemoryの値が、以降の計算で無視されてしまいます。
というわけで新しいモードを作ります。inputtedです*9。
各モードにおける主なボタンの挙動は次のようになります。
| モード | 数字ボタン | 演算ボタン | =ボタン |
| waiting | inputを0にリセットしてから入力された数字を追加する | 次に行う演算を指定しなおす | resultをinputに代入した上で、それぞれを左右のオペランドとして指定された演算を実行する |
| inputted | resultとinputを左右のオペランドとして指定された演算を実行してから次に行う演算を指定する | resultとinputを左右のオペランドとして指定された演算を実行する | |
| inputting | 入力された数字をinputに追加する |
この変更に伴って例えば「waitingモードなら」という条件を「inputtingモードでないなら」とする様な変更をコード内のあちこちでしています。
memoryが0でないときはMが表示されます。表示位置はエラー表示の位置((sconv-x 13), sy)の左隣((sconv-x 14), sy)にしておきましょう。
(define overlay-window (let* (;... (sy (* width 1/12)) (sconv-x (lambda (x) (round (* width (- 9/10 (* 1/20 x))))))) (lambda (scn) (let* (;... (scn (if (and (= 0 (car (num-i memory))) (null? (num-f memory))) scn (place-image (text "M" 40 "#888") (sconv-x 14) sy scn)))) ;... ))))
メモリーキーがないときはinputCの中でinputACを呼び出していましたが、ACがメモリを消去する（memoryを0にする）のに対して、Cはそんなことしないので、inputACからメモリの消去以外の処理を分離しました。分離した処理をinputACとinputCのそれぞれから呼び出し、ACでのみさらにメモリも消去します。
(define (clear) (begin (set! op-no 0) (set! result zero) (set! window result) (set! mode waiting) (set! error-type nothing))) (define (inputAC) (begin (clear) (set! memory zero))) (define (inputC) (if (symbol=? error-type nothing) (if (symbol=? mode waiting) (clear) (begin (set! which-part int) (set! input zero) (set! window input))) (set! error-type nothing)))
メモリ機能を利用してNewton法で√5を計算してみました。初期値は有名な語呂合わせを素直に解釈した数字列*10です。
初期値の誤差が1/104程度なので、5 ÷ MR + MR ÷ 2 だけで収束しますが、この方法で求めたあと、同じ入力を繰り返してメモリ内で精度をあげていく方法でも求めています。前者は近似値xを(5/x+x)/2に置き換え、後者はxを(5/x+x)-(5/x+x)/2に置き換えます。無限精度なら同じですが電卓だと2で割ったときに max-ndigits + 1桁目が切り捨てられるので後者のほうが大きくなることがあります。
— brv00 (@brv00) 2019年11月24日
続きます。
*1:他のキーは〇〇ボタンって言ってたのにいきなりキーとか言い出す。
*2:もう少し複雑な例として、3 + 4 × M+ と押すと、3 + 4 × =が押されたときと同じ挙動をしたあと結果である49がmemoryに加算されます。
*3:サ変動詞の減算ってあんまり聞かないですね。引き算されます。（スルって書いてある辞書もありますね(-.-)）
*4:例えば（max-ndigitsが8のときに） 9 9 9 9 9 9 9 9 M+ 2 M+ と入力した場合。
*5:そういう仕様の電卓しか知らない。
*6:名前を変えずに、メモリに足すときの桁溢れエラーをoverflowにしてもこの仕様通りに動かせそうなことにあとから気づいた。でも平方根ボタンを実装するときにこの変更は役に立つと思います(๑•̀ㅂ•́)و✧ 知らんけど（多分変更せずに平方根つくったらエラーの種類が増える）。
*7:それはそれで面白いかもしれませんが。
*8:多分ポインタを共有しただけだけど、structureの中身を変更できないのでどっちでも同じです。
*9:モード名は全部「数値」を意味する言葉が省かれてる感じ。数値（の入力）を待っている（waiting）、数値を入力中（inputting）、数値を入力し終えた（inputted）。
*10:昔これを聞いて計算してみて合わなくて最終的に「『に』いらんやん(´д｀|||)」ってなった記憶。「に」をいれないバージョンが書いてある本もありますけど（19ページ）。（数の語呂合わせは覚えなくてよいことでも簡単に覚えてしまう強力な方法であり、いきなり聞かされると私自身迷惑に感じることがあるので具体的には書きません）
Simple Scheme で電卓をつくってみる(12) ― 2倍、0、2乗、1 ―
加減乗除が揃い、また、エラー処理ができるようにもなりました。
加減乗除を使った機能を追加しましょう。
電卓で×=と打ち込むと、それまでの計算結果にそれまでの計算結果をかけた値―つまり「それまでの計算結果」の2乗が得られます。
÷=だとそれまでの計算結果をそれまでの計算結果で割った値が得られます。
追加するのはこの機能です。
ちなみに+=や-=は、参考にしている電卓（SL-720L）を動かしてみてもそれまでの計算結果にそれまでの計算結果を足したり引いたりしませんが*1、演算の種類で区別すると条件式が長くなるので加減乗除すべてにこの機能をつけることにします*2。
(define input= (let ((op (make-op 0))) (lambda () (if (symbol=? mode waiting) (begin (set! mode inputting) (set! input result) (op) (set! mode waiting)) (op)))))
（↓2019.11.28 追記）
例えば 3 + 4 × = と入力したときのinputとresult（とwindow）の値をトレースしてみましょう。各ボタンが入力されたあとのそれぞれの変数の値を表にします。
| 初期値 | 3 | + | 4 | × | = | |
| input | 0 | 3 | 4 | 7 | ||
| result | 0 | 3 | 7 | 49 | ||
| window | 0 | input | result | input | result | result |
| (list-ref ops op-no) | get2nd | add | mul | get2nd | ||
3 + 4 × まで押されたとき、モードはwaitingです。また、次に行う計算として、mulが指定されています。
ここでもし演算ボタンを押したらmulに代わってその演算が次に行う計算として指定されます。waitingモードなのでそれ以外に何もしません。計算が実行されるのはinputtingモードのときです。
inputtingモードのときに演算ボタンが押されると、直前に押された演算がresultとinputに適用されます（そのあとで押された演算ボタンに基づいて次に行う計算が指定されます）。
input=はこの演算ボタンの機能を使い回しています。
ここではresultどうしの計算をしたいので、モードを一時的にinputtingに変更し、resultをinputに代入してから演算ボタンの関数*3を呼び出し、その後モードをもとに戻しています。
（↑追記ここまで）
この機能を使って263を概算してみました。64ビット符号つき整数の最大値ですね*4。
— brv00 (@brv00) 2019年11月23日
922.33715という結果が得られましたが桁溢れエラーを1度解除してさらに×=したので16桁右にずれています。だから実際の結果は922.33715×1016です。
また、誤差が生じているのでここから先は手計算で。
まず2のあとに×=を5回繰り返して入力して得られる表示によって、
$$ 42.949672 ≦ 2^{32}\times10^{-8} < 42.949672+10^{-6} $$
であることがわかります。各辺を2乗すると、
$$ 42.949672^2 ≦ 2^{64}\times10^{-16} < 42.949672^2+2\cdot42.949672\times10^{-6}+10^{-12} $$
となります。右辺が複雑なので$2\cdot42.949672\times10^{-6}+10^{-12}<86\times10^{-6}$であることを利用して書き替えます。
$$ 42.949672^2 ≦ 2^{64}\times10^{-16} < 42.949672^2+86\times10^{-6} $$
（エラー解除後）6回目の×=の入力後得られる表示によって、
$$ 1844.6743≦42.949672^2<1844.6743+10^{-4} $$
であることがわかります。これとひとつ前の式から次の関係が得られます。
$$ 1844.6743 ≦ 2^{64}\times10^{-16} < 1844.6743+10^{-4}+86\times10^{-6} $$
最後に1844.6743を2で割る際には丸め誤差は生じていないので他の部分もそのまま2で割って、
$$ 922.33715≦2^{63}\times10^{-16}<922.33715+\left(10^{-4}+86\times10^{-6}\right)/2 $$
が得られます。これを整理して
$$ 9.2233715\times10^{18}≦2^{63}<\left(9.2233715+9.3\times10^{-7}\right)\times10^{18} $$
という関係が得られます。上位6桁は8桁電卓で正確にわかるということですね*5。
×=以外のテストもやったけど録画してない( ´△｀)
続きます。
*1:前者は×2=で代用できますし後者の結果は0なので、この機能がないのは不要だからかもしれません。しかしそれだと結果が常に1になる÷=にこの機能があるのは変なので、単に手元のが壊れているだけかもしれません。あるいは、この電卓にM+ボタンやM-ボタンがあることとなにか関係があるのかもしれません。
*2:なにか問題がありそうなら変えます。メモリ関連でややこしいことになりそうな気が少しする。
*3:演算ボタンを生成する関数によって生成される関数。実行後は次に行う計算として、get2ndが指定されます。
*4:最大値は本当は263-1ですが。
*5:もっと正確かつもっと簡単に調べる方法は電卓以外でいくらでもありますけど。
Simple Scheme で電卓をつくってみる(11) ―エラー処理―
Simple Schemeで電卓を作っています。割り算を組み込んで加減乗除が揃いましたが、0で割ろうとした場合の対応をまったく考えていませんでした。
0で割ろうとすると0除算エラーなので、エラー処理機構を作ります。
桁溢れエラーの処理もここでやってしまいましょう。
(define nothing 'nothing) (define overflow 'overflow) (define divide-by-0 'divide-by-0) (define error-type nothing)
エラー状態はerror-typeという変数にバインドします。エラー状態は3種類あり、エラーでないときはnothing、桁溢れエラーはoverflow、0除算エラーはdivide-by-0です。
error-typeの初期値はnothingです。error-typeには、計算結果が10^max-ndigitsを越えたときと0除算を行おうとしたとき、それぞれのエラー状態が代入され、解除されたとき、初期値であるnothingが代入されます。
(define (check-overflow!) (let* ((i (num-i result)) (li (- (length i) max-ndigits))) (and (> li 0) (begin (set! result (make-num (num-sign result) (take i li) (drop (take i max-ndigits) li))) (set! error-type overflow))))) ; 桁溢れエラー (define (make-op i) (lambda () (and (symbol=? error-type nothing) (begin (and (symbol=? mode inputting) (begin (set! result ((list-ref ops op-no) result input)) (check-overflow!) (set! window result))) ; 0除算エラーでは、エラー直前に押された演算ボタンは無視され、… (set! op-no (if (symbol=? error-type divide-by-0) 0 i)) (set! mode waiting)))))
(define (div x y) (let ((sign (mul-signs-of x y)) (lfy (length (num-f y))) (y (num->int y))) (if (= 0 y) (begin (set! error-type divide-by-0) zero) ; 0除算エラー ...)))
エラーが起こる直前に演算ボタンが押された場合、桁溢れエラーでは、（桁溢れした値が10^max-ndigitsで割られた上で）電卓を例えば次のように操作することで計算を続けることができます。
- エラーを解除する（Cを押す）。
- 数値を入力する。
- 演算ボタンか=を押す。
例えばmax-ndigitsが8のときに333333.33×333333.33÷と入力すると、計算結果の正確な値は111111108888.8889であり、整数部分が8桁を越えているので、エラーになります。このとき表示窓に表示される数値は、正確な値に対して小数点が左に8移動した、1111.1110となります。このあと例えばC33.333333=と入力すると、1111.111÷33.333333が実行され、33.33333という結果が得られます。
つまり桁溢れエラー直前に押された演算ボタンは有効です。
一方、0除算エラーでは、エラー直前に押された演算ボタンは無視され、その後の計算に関与することはありません。Cを押すと、（ほぼ*1）初期状態に戻ります。
つまり0除算エラー直前に押された演算ボタンは無効です。
これは参考にしている電卓（SL-720L）の挙動をそのまま真似しました*2。エラーの種類で挙動を変えるのは面倒だったのですが、0除算の結果を8桁ずらすというのはやりようがない*3ので、桁溢れと異なる挙動にしました。
挙動を変えるためにエラー状態を3種類定義したわけです。
さて、error-typeがoverflowかdivide-by-0のとき、つまりnothingでないとき、CとAC以外のボタンは無効です。
なので、CとAC以外の各ボタン関数の先頭に次のようなコードを挿入しました。
(and (symbol=? error-type nothing)
上のmake-opの定義にも挿入されていますが、つまり、error-typeがnothingのときのみ続きのコードが実行されるわけです。
また、overlay-windowに以下のバインドを挿入して、エラー時にEを表示させるようにしました。
(scn (if (symbol=? error-type nothing) scn (place-image (text "E" 40 "#888") (sconv-x 13) sy scn))))
エラー時に押せるボタンはCとACのみですが、Cが押されたときの挙動はエラー状態の解除のみです。桁をずらして計算可能な範囲に収める等のややこしい処理はすべてエラー発生時にすんでいます。
(define (inputC) (if (symbol=? error-type nothing) ; （帰結部） (set! error-type nothing)))
初期状態がひとつ増えたのでACでやることもひとつ増えました。
(define (inputAC) (begin (set! op-no 0) (set! result zero) (set! window result) (set! mode waiting) (set! error-type nothing)))
桁溢れのときと0除算のときの挙動の例をそれぞれ貼っておきます。
— brv00 (@brv00) 2019年11月22日
— brv00 (@brv00) 2019年11月22日
続きます。
Simple Scheme で電卓をつくってみる(10) ―割り算させてみる―
加減乗除のうちまだないのは除算―割り算だけですね。割り算を組み込みましょう。
電卓の内部で数はリストで表現されていますが、リスト÷リストだと大変なのでリスト÷整数型にします。
まず具体的に割り算してみましょう。
(define (i/% x y) (let ((q (/ x y)) (r (% x y))) (if (< r 0) (list (-- q) (+ r y)) (list q r)))) "3330088÷106" (foldl (lambda (x ds) (append (reverse (i/% (+ x (* 10 (car ds))) 106)) (cdr ds))) '(0) '(3 3 3 0 0 8 8))
あらかじめ整数型に変換した除数で、リストで表された被除数を1要素ずつ割り、余りを（10倍して）次の要素に足しつつ、商を並べていく方法―つまり小学校で習う筆算と同じ方法で割り算しています。
foldlの各段階で、xsの処理済み部分の①余りがdsのcarに入り、②商がひと桁ずつcdrに並びます。また、③xsは先頭から処理されdsは末尾から生成されるので、下位桁ほど手前に来ます。
以上の3点を踏まえてこの実行結果をみると、3330088を106で割ったら余りが98、商が0031415になるということがわかります。
これを核として割り算関数を定義しましょう。
先に商の整数部分を求めれば桁数が調整しやすくなります。
このとき、整数部分と小数部分のそれぞれを求めるため上記の処理は2回実行しなければなりません。字数が多いので関数にしてしまいましょう。
(define (ldiv xs y carry-digit) (foldl (lambda (x ds) (append (reverse (i/% (+ x (* 10 (car ds))) y)) (cdr ds))) (list carry-digit) xs))
まず整数部分を計算します。除数をnum->intで整数にすると、小数点が小数部分の長さ分だけ右に移動することになるので、被除数もそれに合わせて小数点を移動させます。この操作によって被除数の整数部分は(append (num-i x) (trim (num-f x) lfy))となります（trimの定義）。lfyは除数の小数部分の長さです。
このリストをldivを用いて除数で割れば商の整数部分（と余り）が得られます。
割り算関数を整数部分を求めるところまで書いてみます。
(define (div x y) (let ((sign (mul-signs-of x y)) (lfy (length (num-f y))) (y (num->int y))) (let* ((ix (append (num-i x) (trim (num-f x) lfy))) (rq (ldiv ix y 0)) (i (drop0s (reverse (cdr rq)))) (i (if (null? i) '(0) i))) i))) ; テスト "3330088÷106" (div (make-num plus '(3 3 3 0 0 8 8) '()) (make-num plus '(1 0 6) '())) "99999999÷0.5" (div (make-num plus '(9 9 9 9 9 9 9 9) '()) (make-num plus '(0) '(5)))
整数部分の桁数がmax-ndigitsより大きいときはエラーであり*1、小数部分はエラー処理に必要ないので計算せずに空リストを返します。
(if (> (length i) max-ndigits) (make-num sign i '()) ...
そうでないときの小数部分の計算のやり方を考えましょう。
小数点の移動によって被除数の小数部分は、(drop (num-f x) lfy)となります。
また、ldivによって得られる商の長さ*2は第1引数と同じなので、被除数の小数部分を、商の小数部分と同じ長さにtrimすればよいことになります。商の小数部分の長さはmax-ndigitsから商の整数部分の長さを引いた値なので、(trim (drop (num-f x)) (- max-ndigits (length i)))でよさそうです*3。しかしxの小数部分がlfyより短い場合、この式はBad popになり、電卓が止まります。なので、被除数の小数部分を表すリストは次のように求めることにしました*4。
(drop (trim (num-f x) (- (+ max-ndigits lfy) (length i))) lfy)
そして割り算部分の全体は次のようになります。
(define (ldiv xs y carry-digit) (foldl (lambda (x ds) (append (reverse (i/% (+ x (* 10 (car ds))) y)) (cdr ds))) (list carry-digit) xs)) (define (div x y) (let ((sign (mul-signs-of x y)) (lfy (length (num-f y))) (y (num->int y))) (let* ((ix (append (num-i x) (trim (num-f x) lfy))) (rq (ldiv ix y 0)) (i (drop0s (reverse (cdr rq)))) (i (if (null? i) '(0) i))) (if (> (length i) max-ndigits) (make-num sign i '()) (let ((fx (drop (trim (num-f x) (- (+ max-ndigits lfy) (length i))) lfy))) (make-num sign i (reverse (drop0s (cdr (ldiv fx y (car rq))))))))))) ; テスト "3330088÷106" (div (make-num plus '(3 3 3 0 0 8 8) '()) (make-num plus '(1 0 6) '())) "99999999÷0.5" "1÷11" (div (make-num plus '(1) '()) (make-num plus '(1 1) '())) (div (make-num plus '(9 9 9 9 9 9 9 9) '()) (make-num plus '(0) '(5)))
（テストコード全体）
これを電卓に組み込みましょう。このコードを追加するとともに、op-labelsとop-alistとfunc-alistに対し割り算の項目の追加や書き替えを行います。
実際に動かしてみるとこんな感じです。
— brv00 (@brv00) 2019年11月21日
続きます。
Simple Scheme で電卓をつくってみる(9) ―掛け算させてみる―
Simple Schemeで電卓を作っています。
掛け算を組み込みましょう。
多倍長計算します。8桁程度なら64ビット整数どうしでも桁溢れすることなく計算できますが、12桁くらいまでは対応できるようにしたいのと、表示まで考えると整数型は却ってややこしくなる部分があったりするので。
しかし片方だけは64ビット整数にしましょう。そうすれば主要な計算はmapを1回適用するだけで終了します。*1
(define-struct num (sign i f)) (define plus "") (define minus "-") (define (num->list x) (append (num-i x) (num-f x))) (define (num->int x) (foldl (lambda (n i) (+ n (* 10 i))) 0 (num->list x))) (define (mul x y) (let ((xs (num->list x)) (y (num->int y))) (map (lambda (x) (* x y)) xs))) "14175×256" (mul (make-num plus '(1 4 1 7 5) '()) (make-num plus '(2 5 6) '()))
もちろんこの計算結果はこのままでは表示できません。繰り上がり処理が必要です。lopで繰り上がり処理を行っていたのでそこからそのための関数（norm）を抽出しましょう。
(define (i/% x y) (let ((q (/ x y)) (r (% x y))) (if (< r 0) (list (-- q) (+ r y)) (list q r)))) (define (norm xs) (foldr (lambda (x ds) (append (i/% (+ x (car ds)) 10) (cdr ds))) '(0) xs)) ; (define (lop op xs ys) (norm (map2 op xs ys))) (define (mul x y) (let ((xs (num->list x)) (y (num->int y))) (norm (map (lambda (x) (* x y)) xs))))
これを上のコードのmulの呼び出しのすぐ手前のところに貼り付けて実行するとこうなります。
ほぼ表示可能な形式ですが、先頭が10以上になっていますね。
さて、norm関数は、dsの、各段階での先頭要素に対して（未処理部分の末尾を足して）ひと桁分の繰り上がり処理*2を行う、ということを繰り返しています。
この、「ひと桁分の繰り上がり処理を行う」関数をnormから抽出して別関数にしましょう。
(define (carry x ds) (append (i/% (+ x (car ds)) 10) (cdr ds))) (define (norm xs) (foldr carry '(0) xs))
このcarryを、上記のnormの結果に対して、最上位桁が0になるまで*3繰り返し適用すれば繰り上がり処理は完了します。
(define (mul x y) (let ((xs (num->list x)) (y (num->int y))) (letrec ((lp (lambda (xs) (if (= 0 (car xs)) (cdr xs) (lp (carry 0 xs)))))) (lp (norm (map (lambda (x) (* x y)) xs))))))
あとは、符号を決定し、整数部分と小数部分に分けて全体の桁数がmax-ndigits以下になるように調整すれば掛け算は完成です。ただし整数部分の桁数がmax-ndigitsを越えても調整は小数部分に対してのみ行います*4。整数部分の桁数がmax-ndigitsを越えたときの桁数の情報がエラー処理に必要になるからです。
(define (mul-signs-of x y) (if (string=? (num-sign x) (num-sign y)) plus minus)) (define (mul x y) (let ((xs (num->list x)) (y (num->int y)) (sign (mul-signs-of x y)) (lf (+ (length (num-f x)) (length (num-f y))))) (letrec ((lp (lambda (xs) (if (= 0 (car xs)) (cdr xs) (lp (carry 0 xs)))))) (let* ((xs (lp (norm (map (lambda (x) (* x y)) xs)))) (xs (append (get-padding xs (++ lf)) xs)) (li (- (length xs) lf))) (make-num sign (take xs li) (rdrop0s (drop (take xs max-ndigits) (min max-ndigits li))))))))
これを電卓に組み込んで、掛け算ができるようになりました。
— brv00 (@brv00) 2019年11月18日
続きます。
Simple Scheme で電卓をつくってみる(8)
さらに心理的に落ち着くために、これからしようとしている計算が足し算なのか引き算なのか掛け算なのか割り算なのかを表示するようにしましょう。
そのためには、これからしようとしている計算を表す記号を電卓の表示機構に知らせる必要があります。
まず演算記号のリストと関数のリストを作りましょう。このとき、対応する記号と関数が同じ添字の位置に来るようにします。*1
(define op-no 0) (define op-labels (list "" "+" "-")) ; ... (define op-alist (list (list "" get2nd) (list "+" add) (list "-" sub))) (define ops (map (lambda (l) (cadr (assoc l op-alist))) op-labels))
そして、make-opに直接add等を渡すのをやめて、番号（op-no）を渡すことにします。
(define (make-op i) (lambda () (begin (and (symbol=? mode inputting) (begin (set! result ((list-ref ops op-no) result input)) ; add等へは添字でアクセスする (set! window result))) (set! op-no i) (set! mode waiting))))
この番号は主にop-labelsやopsにアクセスするための添字として、また演算記号の表示位置を決めるための値としても使用します。
(define overlay-window (let* ((wdx (* width (/ 3/4 (+ max-ndigits 1/2)))) (iwdx (round wdx)) (wy (* width 9/64)) (sy (* width 5/64)) (sconv-x (lambda (x) (round (* width (- 9/10 (* 1/20 x))))))) (lambda (scn) (let* ((lis (map number->string (append (num-i window) (num-f window)))) (wconv-x (lambda (x) (round (+ (* width 1/8) (* wdx (+ x (- max-ndigits (length lis)) 1)))))) (scn (place-image (text (list-ref op-labels op-no) 60 "#888") ; ここと (sconv-x op-no) sy scn))) ; ここ (foldl (lambda (x scn) (place-image (text (car x) iwdx "black") (cadr x) wy scn)) (place-image (text "." iwdx "black") (wconv-x (- (length (num-i window)) 0.5)) wy (place-image (text (num-sign window) iwdx "black") (wconv-x -0.8) wy scn)) (build-list (length lis) (lambda (i) (list (list-ref lis i) (wconv-x i)))))))))
実際に動かしてみたのがこちらです*2。
— brv00 (@brv00) 2019年11月17日
他にもいろいろ変えたので列挙しておきますね。
続きます。
