;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: :user -*-
;;;
;;; Buyer.lsp
;;;
;;; A simple buyer agent...
;;;
;;; The FishMarket project...
;;;
;;; Francisco J. Martin & Juan A. Rodriguez
;;; {martin,jar}@iiia.csic.es
;;;
;;; Copyright (c) 1997  by the 
;;; Institut d'Investigacion en Intel.ligencia Artificial (IIIA), CSIC
;;; Campus de la Universitat Autonoma de Barcelona
;;; 08193 Bellaterra, Barcelona, Spain
;;;  
;;;    
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted,
;;;   provided that this copyright and permission notice appear in all
;;;   copies and supporting documentation, and that the name of IIIA-CSIC not
;;;   be used in advertising or publicity pertaining to distribution of the
;;;   software without specific, written prior permission. IIIA-CSIC makes no
;;;   representations about the suitability of this software for any
;;;   purpose.  It is provided "as is" without express or implied warranty.
;;;          
;;;   IIIA-CSIC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
;;;   ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
;;;   IIIA-CSIC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;;;   ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
;;;   WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
;;;   ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
;;;   SOFTWARE.
;;;                   
;;; Created: 1996 09 22 17:11
;;;
;;; Last modification: 1997 06 09 16:51 

;;;-------------------------------------------------------
;;;
;;; Communicating functions
;;;
;;;-------------------------------------------------------

;;; *
(defun send (stream string &rest args)
 "Writes the string formatted with args in stream"
 (declare (dynamic-extent args))
 (format t "~%")
 (apply #'format t string args)
 (format t "~%")
 (apply #'format stream string args)
 ;(write-char #\LineFeed stream)
 (force-output stream) 
)

(defun stream-eofp (stream)
 "Checks for the end of stream"
 (if (peek-char nil stream nil nil)
  nil
  t
 )
)

(defun stream-tyi (stream)
 "Reads a new character from stream"
 (read-char stream nil nil)
)

(defun receive (stream)
 "Reads one line that ended with the Linefeed char from stream"
 (unless (stream-eofp stream)
  (let
   ((line (Make-Array 10 :Element-Type 'base-Character
                         :Adjustable t
                         :Fill-Pointer 0
          )
    )
    (char nil)
   )
   (do ()
    ((or (null (setq char (stream-tyi stream)))
         (eq char #\Linefeed))
    (values (coerce line 'simple-string) (null char)))
    (vector-push-extend char line)
   )
  )
 )
)

;;; *
(defun get-parameter (message)
 (let ((parameter (read message nil nil)))
  (format t "~A " parameter)
  parameter 
 )
)



;;;-------------------------------------------------------
;;;
;;; Fish market world...
;;;
;;;-------------------------------------------------------


;;; Downward Bidding Protocol

(defconstant *Ps* 10)
(defconstant *to* 500)
(defconstant *tr* 2000)
(defconstant *Cmax* 3)
(defconstant *Sf* 0.25)
(defconstant *Pi* 0.25)
(defconstant *e*  0) ;;; *


;;; Auctions 

(defconstant *number-of-auctions* 21)
(defconstant *ta* 5000)

(defvar *current-auction* 0)
(defvar *round-number* 0)

(defconstant *auction-credit* 50000.0)

(defvar *my-credit*           (make-array *number-of-auctions* :initial-element *auction-credit*))
(defvar *my-expected-benefit* (make-array *number-of-auctions* :initial-element 0.0))
(defvar *my-shopping-list*  (make-array *number-of-auctions* :initial-element nil))
(defvar *current-good* nil) 
(defvar *current-price* nil) ;;; *
(defvar *I-bid* nil)
(defvar *I_can_bid* nil) ;;; **



;;;-------------------------------------------------------
;;;
;;; Goods
;;;
;;;-------------------------------------------------------


(defvar *goods-to-be-sold* (make-array *number-of-auctions*))
(defvar *sold-goods*   (make-array *number-of-auctions*))       
(defvar *not-sold-goods* (make-array *number-of-auctions*))

(defun add-good (good) 
 (setf (aref *goods-to-be-sold* *current-auction*) (append (aref *goods-to-be-sold* *current-auction*) (list good)))
)

(defstruct good
 identifier 
 kind
 seller
 (init-price 0)
 (retention-price 0)
 (resale-price 0)
 (buyer nil)
 (price 0) 
)

(defun benefit (good)
 (- (good-resale-price good) (good-price good)) 
)

;;;-------------------------------------------------------
;;;
;;; Buyers
;;;
;;;-------------------------------------------------------

(defvar *buyers-in*   (make-array *number-of-auctions*))
(defvar *buyers-out*  (make-array *number-of-auctions*))
(defvar *expelled-buyers* (make-array *number-of-auctions*))

(defstruct buyer 
 name
 (goods  nil)
 (benefit  0)
 (expenses 0)
)

(defun update-expenses (buyer good expense)
 (let ((bi (find buyer (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name)))
  (setf (buyer-goods bi) (append (buyer-goods bi) (list (good-identifier good)))) 
  (incf (buyer-expenses bi) expense)
  (incf (buyer-benefit bi) (benefit good))
 )
)
 
;;;-------------------------------------------------------
;;;
;;; Who am I?
;;;
;;;-------------------------------------------------------

(defconstant *my-login*     "jarisco")
(defconstant *my-password*  "jarisco")

;;;=======================================================
;;;
;;; Messages
;;; 
;;;=======================================================

(defun catch-the-remote-control ()
 "Takes the remote control executing the Jarisco java program"
 (run-program "Jarisco"
  :arguments `(,*my-login*)
  :input :stream
  :output :stream
 )
)

;;;-------------------------------------------------------
;;;
;;; My illocutions
;;;
;;;-------------------------------------------------------

;;; *
(defun go-into-auction-room (remote-control)
 (send remote-control "admission ~A ~A~%" *my-login* *my-password*)
)

;;; *
(defun bid (remote-control)
 (send remote-control "bid~%")
)

;;; *
(defun exit-from-the-market (remote-control)
 (send remote-control "exit~%") 
)

;;;-------------------------------------------------------
;;;
;;; Remote Control illocutions
;;;
;;;-------------------------------------------------------

;;; *
(defun get-message (pannel)
 (format t "~%~%")
 (let* ((message (make-string-input-stream (string (receive pannel))))          
        (predicate (get-parameter message)))
  (when predicate 
   (ecase predicate 
    (deny          (get-deny-code message))
    (accept        'ready-to-bid)
    (open_auction  (get-auction-number message))
    (open_round    (get-round-number message))
    (good          (get-good-info message))
    (buyers        (update-list-buyers message))
    (goods         (update-list-goods message))
    (offer         (get-price-info message))
    (sold          (get-sale-info message))
    (sanction      (get-sanction-info message))
    (expulsion     (get-expelled-buyer message))
    (collision     (get-collision-price message))
    (out_of_market (get-not-sold-good message))
    (end_round     (get-round-closed-number message))
    (end_auction   (get-auction-closed-number message))
    (closed_market (close-the-auction)) 
   )
  )
 )
)

;;;-------------------------------------------------------
;;;
;;; Buyer actions
;;;
;;;-------------------------------------------------------

(defun get-deny-code (message)
 (format t "~%Access denied: ~A~%" (get-parameter message))
)

;;; *
(defun get-auction-number (message)
 (setf *current-auction* (- (get-parameter message) 1))
 (setf *current-good* nil)
 (setf *current-price* nil)
)

;;; *
(defun get-auction-closed-number (message)
 (get-parameter message)
 (setf *go-on* nil)
)

;;; *
(defun get-round-number (message)
 (setf *round-number* (- (get-parameter message) 1))
 (setf *current-good* nil)
 (setf *current-price* nil)
 (setf *I_can_bid* nil)
)

;;; *
(defun get-round-closed-number (message)
 (get-parameter message)
)

;;; *
(defun get-good-info (message)
 (let ((bi (get-parameter message))
       (gi (get-parameter message))
       (si (get-parameter message))
       (p-i (get-parameter message))
       (ri (get-parameter message)) 
      )
  (setf *current-good* (find bi (aref *goods-to-be-sold* *current-auction*)  :test 'eq :key #'good-identifier))
  (setf *current-price* p-i)
  (setf (aref *goods-to-be-sold* *current-auction*)
   (remove bi (aref *goods-to-be-sold* *current-auction*)  
    :test 'eq :key #'good-identifier)
  )    
 )
)

;;; *
(defun update-list-buyers (message)
 (let ((buyers nil))
  (loop
   while (listen message)
   do (let* ((buyer-name (get-parameter message))
             (bi (find buyer-name (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name)))
       (if bi
        (progn 
         (setf buyers (append buyers (list bi)))
         (setf (aref *buyers-in* *current-auction*) 
          (remove buyer-name (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name)) 
        )
        (setf buyers (append buyers (list (make-buyer :name buyer-name))))                 
       )
      )
  )
  (mapcar  #'(lambda (b) (pushnew b (aref *buyers-out* *current-auction*)) :test #'eq :key #'buyer-name)
   (aref *buyers-in* *current-auction*))
  (setf (aref *buyers-in* *current-auction*) buyers)
 )  
)

(defun update-list-goods (message)
 (loop
  while (listen message)
  do (let ((bi (get-parameter message))
           (gi (get-parameter message))
           (si (get-parameter message))
           (p-i (get-parameter message))
           (ri (get-parameter message)) 
          )
      (add-good (make-good :identifier bi :kind gi :seller si :init-price p-i :resale-price ri))
     )
 ) 
)

;;; *
(defun get-price-info (message)
 (let ((gi (get-parameter message))
       (pi (get-parameter message)))
  (setf *current-price* pi)
  (setf *I_can_bid* t)
 )
)

;;; *
(defun get-sale-info (message)
 (let ((bi (get-parameter message))
       (p-i (get-parameter message)))
  (setf (good-buyer *current-good*) bi)
  (setf (good-price *current-good*) p-i)
  (update-expenses bi *current-good* p-i)
  (when *I-bid* 
   (when (eq bi (read-from-string *my-login*))
    (decf (aref *my-credit* *current-auction*) p-i)
    (incf (aref *my-expected-benefit* *current-auction*) (benefit *current-good*))
    (setf (aref *my-shopping-list* *current-auction*) (append (aref *my-shopping-list* *current-auction*) (list *current-good*))) 
   )
   (setf *I-bid* nil)  
  )
  (setf *current-good* nil)
 ) 
)

;;; *
(defun get-sanction-info (message)
 (let* ((buyer-name (get-parameter message)) 
        (bi (find buyer-name (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name))
        (quantity   (get-parameter message)))
  (incf (buyer-expenses bi) quantity)  
 )
)

(defun get-expelled-buyer (message)
 (let* ((buyer-name (get-parameter message))
        (bi (find buyer-name (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name)))
  (setf (aref *expelled-buyers* *current-auction*) (append (aref *expelled-buyers* *current-auction*) bi))
  (setf (aref *buyers-in* *current-auction*) (remove buyer-name (aref *buyers-in* *current-auction*) :test #'eq :key #'buyer-name))  
 ) 
)

(defun get-collision-price (message)
 (get-price-info message)
)

;;; *
(defun get-not-sold-good (message)
(let ((g-i (get-parameter message))
      (p-i (get-parameter message)))
  (setf (good-retention-price *current-good*) p-i)
  (setf (aref *not-sold-goods* *current-auction*) (append (aref *not-sold-goods* *current-auction*) (list *current-good*)))
  (setf *current-good* nil)
  (setf *current-price* nil)
 )
)

(defun close-the-auction ()
 (setf *go-on* nil)
)




;;;-------------------------------------------------------
;;;
;;; Strategy
;;;
;;;-------------------------------------------------------

(defvar *go-on* t)

;;; *
(defun To-bid-or-not-to-bid (remote-control) 
 (format t "To bid or not to bid....")
 (when (and *current-good* *current-price*
            (< *current-price* (aref *my-credit* *current-auction*))
            (< *current-price* (good-resale-price *current-good*))
            *I_can_bid*
            (= (random 2) 0)) 
   (bid remote-control)
   (setf *I-bid* t)
  )
 (setf *I_can_bid* nil)   
)

;;;-------------------------------------------------------
;;;
;;; Buyer
;;;
;;;-------------------------------------------------------

;;; *
(defun Run ()
 (multiple-value-bind (remote&pannel pannel remote-control) 
  (catch-the-remote-control)
  (go-into-auction-room remote-control)
  (loop 
   while (< *current-auction* *number-of-auctions*)
   do
    ;(go-into-auction-room remote-control)
    (when (eq (get-message pannel) 'ready-to-bid)
     (loop
      with go-on = t
      while go-on
      do (get-message pannel)
         (To-bid-or-not-to-bid remote-control) 
         (setf go-on *go-on*)
     )
    ) 
  )
 )
)