Help me clean up this function

Discussion of Common Lisp

Help me clean up this function

Postby Gopher » Mon Nov 25, 2013 1:24 am

Hey all, I've just recently started studying common lisp. I really like it so far, seems like a pretty elegant language. I come from a background of more object oriented interpreted languages, such as PHP, haXe, and actionscript.

This isn't a homework assignment, but I'm having problems with a personal project. It's sort of a stock-market game. The purpose of this function is to register a new "bid" order.

Task:
-collect the user-id, the commodity he wants to buy, the quantity he wants to buy, and the highest price he's willing to pay.
-pull up the list of existing "ask" orders, and determine which ones are a match. If the ask price is lower than the bid price, fill both orders at the ask price.
-update the ask list accordingly
-if the new bid order is not completely filled, add it to the list of bids.

It's a somewhat complicated task, and with my lack of experience the function I came up with just feels awful spaghetti code that doesn't even work:
Code: Select all
(defun immediate-bid (player-id commodity price quantity) ;this function determines how many units can be sold immediately, before logging the new order
   (let ((exchange (get-record commodity)) (old-order ()))
      (loop named askloop while (setf old-order (pop (cdr (assoc 'asks exchange)))) do ;iterate through all ask orders
         (progn
            (when (> (cdr (assoc 'price old-order)) price) (return-from askloop)) ;if the next ask is higher than the bid price, break
            (let (sales (min (cdr (assoc 'quantity old-order)) quantity)) ;"sales" the quantity that can be sold from this ask order to this bid order
               (update-comm-list player-id commodity sales);credit the buyer
               (update-comm-list (cdr (assoc 'player old-order)) 'money (* sales (cdr (assoc 'price old-order))));credit the seller
               (setf (cdr (assoc 'player old-order)) (- (cdr (assoc 'player old-order)) sales)) ;update the ask order to reflect the sales
               (setf quantity (- quantity sales)) ;update the new bid order to reflect the sales
               (when (> (min (cdr (assoc 'quantity old-order)) 0)) ;if the old order isn't completely filled, return it to the exchange
                  (progn
                     (push old-order (cdr (assoc 'asks exchange)))
                  )
               )
               (when (<= quantity 0) ; if the new order IS completely filled, return
                  (progn
                     (set-record exchange)
                     (return-from immediate-bid 0)
                  )
               )
            )
         )
      )
      (progn
         ;create and set the order
         (push (pairlis (list 'id 'player 'price 'quantity) (list (random-id) player-id price quantity)) (cdr (assoc 'bids exchange)))
         ;TODO: sort the exchange
         (set-record exchange)
         quantity
      )
   )
)


Functions not seen here:
-"get-record (id)" pulls an object from a file based on the identifier it's provided.
-"set-record (record)" is the counterpart to get-record. It saves the object according to its internal identifier.
-"update-comm-list (comm-list-id commodity quantity)" adds the specified quantity of the specified commodity to the specified user's inventory.
-"random-id" interns a random ten character string.

Notes:
- an exchange is an associative list containing a list of bids and a list of asks for a given commodity
-"asks" are stored in a pre-sorted list, from lowest to highest

If someone could help me with best practices, proper lisp protocol, and such it would be much appreciated. I just feel there has to be a better way than what I did. Thanks in advance, I could really use some guidance.
Gopher
 
Posts: 18
Joined: Mon Nov 25, 2013 1:01 am

Re: Help me clean up this function

Postby Gopher » Thu Nov 28, 2013 5:18 pm

In the several days in between when I first made this post and now, here's what I came up with:

Code: Select all
(defun cadsoc (key lis) (cdr (assoc key lis)))

(defun (setf cadsoc) (value key lis) (if (assoc key lis) (setf (cdr (assoc key lis)) value) (setf (cdr (last lis)) (cons (cons key value) ()))))

(defun immediate-bid (player-id commodity price quantity) ;this function determines how many units can be sold immediately, before logging the new order
   (let ((exchange (get-record commodity)) (old-order ()) (new-id (random-id)))
      (loop named askloop while (setf old-order (pop (cadsoc 'asks exchange))) do ;iterate through all ask orders
         (when (> (cadsoc 'price old-order) price) (return-from askloop)) ;if the next ask is higher than the bid price, break
         (let (sales (min (cadsoc 'quantity old-order) quantity)) ;"sales" the quantity that can be sold from this ask order to this bid order
            (credit-inventory player-id commodity sales);credit the buyer
            (credit-inventory player-id 'money (* sales (- price (cadsoc 'price old-order))));give the leftover money to the buyer as well
            (credit-inventory (cadsoc 'player old-order) 'money (* sales (cadsoc 'price old-order)));credit the seller
            (setf (cadsoc 'quantity old-order) (- (cadsoc 'quantity old-order) sales)) ;update the ask order to reflect the sales
            (setf quantity (- quantity sales)) ;update the new bid order to reflect the sales
            (when (> (cadsoc 'quantity old-order) 0) ;if the old order isn't completely filled, return it to the exchange
               (push old-order (cadsoc 'asks exchange))
            )
            (when (<= quantity 0) ; if the new order IS completely filled, return
               (set-record exchange)
               (return-from immediate-bid ())
            )
         )
      )
      ;create and set the order
      (push (pairlis (list 'id 'player 'price 'quantity) (list new-id player-id price quantity)) (cadsoc 'bids exchange))
      (set-record commodity)
      (sort-exchange commodity)
      new-id
   )
)
-eliminated unnecessary "progn"s.
-replaced a bunch of (cdr (assoc)) with more streamlined cadsoc function.
-changed name of "update-comm-list" to "credit-inventory" for more readability.
Gopher
 
Posts: 18
Joined: Mon Nov 25, 2013 1:01 am


Return to Common Lisp

Who is online

Users browsing this forum: Yahoo [Bot] and 2 guests

cron