;;;   file name: G:\datepstk\study-tk
;;;                \MS-tk-v01
;;;                \prog-tk-shiyo-suru
;;;                \price-model-type001
;;;                \quantity-for-price-type001-fun-v014.lsp
;;;
;;;      v014 ( May 26, 2003 )
;;;


(defun quantity-for-price-type001-fun
       ( alpha-pri beta-pri 
         start-price stop-price increment-price )

;;;
;;;   実行に必要なprogram file: 
;;;     price-list-type001-fun-v005.lsp
;;;       （ただし、v005はversion 5であることを
;;;         示しており、変更されている場合がある。）
;;;


   (cond ( (or  (<= alpha-pri 0) (>= beta-pri 0)  )  
           (print "alpha-pri must be larger than 0 or")(terpri)
           (print "beta-pri must be less than 0.")(terpri)
           (format t " alpha-pri = ~12d" alpha-pri)(terpri)
           (format t " beta-pri     = ~12d" beta-pri)(terpri)
           (setf alpha-pri 2000)
           (setf beta-pri -8)
           (format t " alpha-pri(changed) = ~12d" alpha-pri)(terpri)
           (format t " beta-pri(changed)     = ~12d" beta-pri)(terpri) 
         )
         (t)
   )

   (setf rest-price
         (price-list-type001-fun
            start-price stop-price increment-price)
   )     ;;; initial value of rest-price 

   (if (numberp rest-price) (setf rest-price (list rest-price)
                           )   ;;; priceが1つの要素である際には、
   )   ;;; それをlistに変換する。no-of-alternatives は1である。


   (defun quantity-for-price-one-element-fun (price-one-element)

      (cond ( ( <= price-one-element (/ alpha-pri (* -1 beta-pri)
                                     )
              )

              (setf quantity-for-price-one-element
                   (+ alpha-pri (* beta-pri price-one-element)
                   )   
              )      ;;; [alpha-pri] + [beta-pri] * [price-one-element]

            )

            (t (setf quantity-for-price-one-element 0)
            )

      )  

      quantity-for-price-one-element

   )

   (cond ( (<= no-of-alternatives 1)
           (setf first-rest-price (first rest-price)
           )
           (def quantity-for-price-type001
                (list
                   (quantity-for-price-one-element-fun first-rest-price)   
                )
           )
         )
         ( (= no-of-alternatives 2)
           (setf first-rest-price (first rest-price)
           )
           (def quantity-for-price-type001
                (quantity-for-price-one-element-fun first-rest-price)
           )
           (setf first-rest-price (first (rest rest-price)
                                  )
           )
           (def quantity-for-price-type001
                (combine quantity-for-price-type001
                   (quantity-for-price-one-element-fun first-rest-price)
                )
           )
         )
         ( (>= no-of-alternatives 3)

           (let
              ( (i 1)
              )
              (setf first-rest-price (first rest-price)
              )
              (def quantity-for-price-type001
                   (quantity-for-price-one-element-fun first-rest-price)
              )
              (setf rest-price (rest rest-price)
              )

              (loop (if (> i (- no-of-alternatives 1)
                        ) (return) 
                    )
                    (setf first-rest-price (first rest-price)
                    )
                    (def quantity-for-price-type001
                         (combine quantity-for-price-type001
                            (quantity-for-price-one-element-fun 
                                first-rest-price)
                         )
                    )

                    (setf rest-price (rest rest-price)
                    )

                    (setf i (+ i 1)
                    )
              )
            )
         )
   )

   quantity-for-price-type001

)