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)