TOP
Gaucheでコンニャク玉年生別作付面積比率計算
letを使った変数の束縛も、named-letの再帰も、複数の関数を一つに纏めるbeginも、書けるものは全て lambda式 で書いてみました。
#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-
(define 1nensei-menseki-hiritsu 0.175)
(define 2nensei-menseki-hiritsu 0.325)
(define 3nensei-menseki-hiritsu 0.500)
(define (konnyaku-keisan)
((lambda (loop0)
(set! loop0
(lambda (count)
(newline)
(display "コンニャク玉年生別作付面積比率計算") (newline)
(newline)
((lambda (loop1)
(set! loop1
(lambda (count)
(display "コンニャク圃場の全面積 a (アール) を入力") (newline)
((lambda (hojyou-menseki)
(if (not (real? hojyou-menseki))
((lambda () (newline)
(display "面積を入力してください") (newline)
(newline)
(loop1 (+ count 1))))
((lambda ()
((lambda (loop2)
(set! loop2
(lambda (count)
(display "生子・1年生玉の畦幅を入力 0.40(m)から0.60(m)まで") (newline)
((lambda (1nensei-unehaba)
(if (not (and (real? 1nensei-unehaba) (<= 0.40 1nensei-unehaba 0.60)))
((lambda () (newline)
(display "畦幅を入力してください") (newline)
(newline)
(loop2 (+ count 1))))
((lambda ()
((lambda (loop3)
(set! loop3
(lambda (count)
(display "生子・1年生玉の株間を入力 0.10(m)から0.15(m)まで") (newline)
((lambda (1nensei-kabuma)
(if (not (and (real? 1nensei-kabuma) (<= 0.10 1nensei-kabuma 0.15)))
((lambda () (newline)
(display "株間を入力してください") (newline)
(newline)
(loop3 (+ count 1))))
((lambda ()
((lambda (loop4)
(set! loop4
(lambda (count)
(display "1年生玉収穫時の重量を入力 0.05(kg)から0.20(kg)まで") (newline)
((lambda (1nensei-jyuuryou)
(if (not (and (real? 1nensei-jyuuryou) (<= 0.05 1nensei-jyuuryou 0.20)))
((lambda () (newline)
(display "重量を入力してください") (newline)
(newline)
(loop4 (+ count 1))))
((lambda ()
((lambda (loop5)
(set! loop5
(lambda (count)
(display "2年生玉の畦幅を入力 0.40(m)から0.60(m)まで") (newline)
((lambda (2nensei-unehaba)
(if (not (and (real? 2nensei-unehaba) (<= 0.40 2nensei-unehaba 0.60)))
((lambda () (newline)
(display "畦幅を入力してください") (newline)
(newline)
(loop5 (+ count 1))))
((lambda ()
((lambda (loop6)
(set! loop6
(lambda (count)
(display "2年生玉の株間を入力 0.15(m)から0.40(m)まで") (newline)
((lambda (2nensei-kabuma)
(if (not (and (real? 2nensei-kabuma) (<= 0.15 2nensei-kabuma 0.40)))
((lambda () (newline)
(display "株間を入力してください") (newline)
(newline)
(loop6 (+ count 1))))
((lambda ()
((lambda (loop7)
(set! loop7
(lambda (count)
(display "2年生玉収穫時の重量を入力 0.30(kg)から1.00(kg)まで") (newline)
((lambda (2nensei-jyuuryou)
(if (not (and (real? 2nensei-jyuuryou) (<= 0.30 2nensei-jyuuryou 1.00)))
((lambda () (newline)
(display "重量を入力してください") (newline)
(newline)
(loop7 (+ count 1))))
((lambda ()
((lambda (loop8)
(set! loop8
(lambda (count)
(display "3年生玉の畦幅を入力 0.40(m)から0.60(m)まで") (newline)
((lambda (3nensei-unehaba)
(if (not (and (real? 3nensei-unehaba) (<= 0.40 3nensei-unehaba 0.60)))
((lambda () (newline)
(display "畦幅を入力してください") (newline)
(newline)
(loop8 (+ count 1))))
((lambda ()
((lambda (loop9)
(set! loop9
(lambda (count)
(display "3年生玉の株間を入力 0.40(m)から0.60(m)まで") (newline)
((lambda (3nensei-kabuma)
(if (not (and (real? 3nensei-kabuma) (<= 0.40 3nensei-kabuma 0.60)))
((lambda () (newline)
(display "株間を入力してください") (newline)
(newline)
(loop9 (+ count 1))))
((lambda ()
((lambda (loop10)
(set! loop10
(lambda (count)
(display "3年生玉収穫時の重量を入力 1.30(kg)から1.80(kg)まで") (newline)
((lambda (3nensei-jyuuryou)
(if (not (and (real? 3nensei-jyuuryou) (<= 1.30 3nensei-jyuuryou 1.80)))
((lambda () (newline)
(display "重量を入力してください") (newline)
(newline)
(loop10 (+ count 1))))
((lambda ()
(newline)
(display "コンニャク1年生玉の作付面積") (newline)
(display "(* ") (display hojyou-menseki) (display " ") (display 1nensei-menseki-hiritsu)
(display ") = ")
(display
(/
(round
(* 1000
(* hojyou-menseki 1nensei-menseki-hiritsu)
)) 1000))
(display " a (アール)")
(newline)
(display "コンニャク1年生玉の収穫時の総個数") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(*
(/ (* (sqrt (* hojyou-menseki 1nensei-menseki-hiritsu)) 10) 1nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 1nensei-menseki-hiritsu)) 10) 1nensei-kabuma)
))) 100))
(display " 個") (newline)
(display "コンニャク1年生玉の収穫時の総重量") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(* 1nensei-jyuuryou
(*
(/ (* (sqrt (* hojyou-menseki 1nensei-menseki-hiritsu)) 10) 1nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 1nensei-menseki-hiritsu)) 10) 1nensei-kabuma)
)))) 100))
(display " kg (キログラム)")
(newline)
(newline)
(display "コンニャク2年生玉の作付面積") (newline)
(display "(* ") (display hojyou-menseki) (display " ") (display 2nensei-menseki-hiritsu)
(display ") = ")
(display
(/
(round
(* 1000
(* hojyou-menseki 2nensei-menseki-hiritsu)
)) 1000))
(display " a (アール)")
(newline)
(display "コンニャク2年生玉の収穫時の総個数") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(*
(/ (* (sqrt (* hojyou-menseki 2nensei-menseki-hiritsu)) 10) 2nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 2nensei-menseki-hiritsu)) 10) 2nensei-kabuma)
))) 100))
(display " 個") (newline)
(display "コンニャク2年生玉の収穫時の総重量") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(* 2nensei-jyuuryou
(*
(/ (* (sqrt (* hojyou-menseki 2nensei-menseki-hiritsu)) 10) 2nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 2nensei-menseki-hiritsu)) 10) 2nensei-kabuma)
)))) 100))
(display " kg (キログラム)")
(newline)
(newline)
(display "コンニャク3年生玉の作付面積") (newline)
(display "(* ") (display hojyou-menseki) (display " ") (display 3nensei-menseki-hiritsu)
(display ") = ")
(display
(/
(round
(* 1000
(* hojyou-menseki 3nensei-menseki-hiritsu)
)) 1000))
(display " a (アール)")
(newline)
(display "コンニャク3年生玉の収穫時の総個数") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(*
(/ (* (sqrt (* hojyou-menseki 3nensei-menseki-hiritsu)) 10) 3nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 3nensei-menseki-hiritsu)) 10) 3nensei-kabuma)
))) 100))
(display " 個") (newline)
(display "コンニャク3年生玉の収穫時の総重量") (newline)
(display "約 ")
(display
(/
(truncate
(* 100
(* 3nensei-jyuuryou
(*
(/ (* (sqrt (* hojyou-menseki 3nensei-menseki-hiritsu)) 10) 3nensei-unehaba)
(/ (* (sqrt (* hojyou-menseki 3nensei-menseki-hiritsu)) 10) 3nensei-kabuma)
)))) 100))
(display " kg (キログラム)")
(newline)
(newline)
(display "続ける(0) 終了する(1)") (newline)
((lambda (cont) (newline)
(if (not (zero? cont))
(begin (newline)
(display "計算終了") (newline)
(newline))
(begin
(loop0 (+ count 1)))))
(read))
))
)
)
(read))
)
)
(loop10 1))
'())
))
)
)
(read))
)
)
(loop9 1))
'())
))
)
)
(read))
'())
)
(loop8 1))
'())
))
)
)
(read))
'())
)
(loop7 1))
'())
))
)
)
(read))
'())
)
(loop6 1))
'())
))
)
)
(read))
'())
)
(loop5 1))
'())
))
)
)
(read))
'())
)
(loop4 1))
'())
))
)
)
(read))
'())
)
(loop3 1))
'())
))
)
)
(read))
'())
)
(loop2 1))
'())
))
)
)
(read))
'())
)
(loop1 1))
'())
)
)
(loop0 1))
'())
)
(define (main args)
(konnyaku-keisan)
0)