[macosxnerd101]

We've had a backlog of a few weeks to clear up, so there will be multiple challenges to catch up. This challenge, Scheme, was created by SwiftStriker00.

Intro to Being a Purely Procedural Schemer


CHALLENGE:
Try and create a few functions in Scheme, especially recursive ones

INTRODUCTION: Scheme is a lightweight, fast, and powerful language. Prepare to get your car and cdr on! One of the features is it is programmed recursively, which will truly allow you make some very creative programs. On the other hand if you are weak with recursion and its concepts it will force you to become better at it, and will only benefit from it.

IDEAS:

• Hello World (see below)
  
• String Manipulation
  
• Calculator
  
• Discrete Math Concepts (patterns and logic)
  
• Display Pascal's Triangle
  
• Custom Collections & Sorting algorithms
  
• CGI scripts

RESOURCES:
IDE & Complier: DrScheme (~26Mb) (a.k.a. PLT Scheme)
http://en.wikipedia....mming_language)
ftp://ftp.cs.utexas....hintro_toc.html
http://www.ccs.neu.e...t-y-scheme.html

If you have any questions Dream.In.Code does not have a language specific forum, however the do have a Functional Programming Forum, BUT Dream.In.Code does have Snippets!

HOW TO GET STARTED:
The official site for DrScheme has a very good getting started page: http://docs.plt-scheme.org/quick/
I suggest setting your language to: R5RS, its a pretty standard one
Just remember you can work right from the pompt, or you can save a .scm file and run your program from there. Try and build a library of functions to use!

Quick Start at what Hello World looks like:

;Your first program
(begin
  (display "Hello, World!")
  (newline)
)

Next Step is mastering the 3 C's; car cdr and cons. Take a look what happens, what is saved? how is it displayed?

(define numbers (cons 1 (cons 2  3)))
(display (car numbers))
(newline)
(display (cdr numbers))
(newline)
(cons numbers (car numbers))
(display numbers)

[Raynes]

I'll note that plt-scheme is called Racket now http://racket-lang.org/new-name.html

Also, if SwiftStriker00 happens to look, what did you mean by "Purely Procedural Schemer"? Scheme is a functional Lisp.

[Simown]

I finished this project a while ago, but it is my most recent project. I can still enter it, right?

It is written in a message passing / OOP style and implements a instrument shop, library and hire service.

Pastebin - for better syntax highlighting

;       INSTRUMENT

(define (an-instrument type value)
  (let (
        (owner #f)
        )

    ;REQUESTS
    (define (the-instrument op)
      (cond ((eq? op 'set-owner) (lambda (o) (set-owner o)))
            ((eq? op 'type)      (lambda () type)) ;Returns the type
            ((eq? op 'owner)     (lambda () owner));Returns the owner
            ((eq? op 'value)     (lambda () value));Returns the value
            (else (error "the-instrument - operation not defined: " op))
         )
      )
    
  ;INTERNAL METHODS
    
  ;Set the instruments owner  
    (define (set-owner o)
    (begin
      (set! owner o)
      #t)
    ) 
    
     ;Validates the parameters to the-instrument object
    (define (instrument? t v)
    ;Validate the type
    (define (type? t)
      (cond 
            ((not (symbol? t)) (error "an-instrument - type not a symbol: " t))
            (else #t)
            )
      )
    ;Validate the value
    (define (value? v)
    (cond
      ((not (number?  v)) (error "an-instrument - not a value: " v))
      ((not (> v 0)) (error "an-instrument - not a positive value:" v))
      ((not (real? v)) (error "an-instrument - not a real value: " v))
      )
  )
    
      (if (and (value? v) (type? t)) #t)
      
      )  
     
  (begin 
  (instrument? type value)
   the-instrument
                 )             
              )
            )

;GLOBAL PROCEDURES
;set the owner
(define (set-owner i o)
  ((i 'set-owner) o)
  )
;get the instrument type
(define (type i)
  ((i 'type))
  )
;get the instrument owner
(define (owner i)
  ((i 'owner))
  )
;get the instrument value
(define (value i)
  ((i 'value))
  )

; PLAYER

(define (a-player)
  (let
      (
       (the-collection nil)
       )
    ;REQUESTS
    (define (the-player op)
      (cond ((eq? 'acquire op)     (lambda (i) (acquire the-collection i)))
            ((eq? 'remove op)      (lambda (i) (remove i)))
            ((eq? 'collection op)  (lambda (o) (current-collection the-collection o)))
            (else (error "the-player - operation not defined: " op))
            )
      )
    
;INTERNAL METHODS
      
 ;Add instrument to the players collection - the-collection
  (define (acquire collection instrument) 
     (cond
      ((null? collection) (begin 
                            (set! the-collection (cons instrument the-collection)))
                            (if (eq? (owner instrument) #f) (set-owner instrument the-player))
                            #t)
      ((eq? (car collection) instrument) #f)
      (else (acquire (cdr collection) instrument))
      )
    )
    
;Remove instrument from the-collection
(define (remove instrument)
  
(define (remove-item collection instrument)
  (cond
    ((null? collection) nil)
    ((not (eq? (car collection) instrument)) (cons (car collection) (remove-item (cdr collection) instrument)))
    (else (remove-item (cdr collection) instrument))
  )
)

(if (equal? the-collection (remove-item the-collection instrument)) nil
(begin
  (set! the-collection (remove-item the-collection instrument))
  instrument)

      )
  )

;Current collection
(define (current-collection collection the-owner)
(cond
  ((null? collection) nil)
  ((eq? (owner (car collection)) the-owner) (cons (car collection) (current-collection (cdr collection) the-owner)))
  (else (current-collection (cdr collection) the-owner))
))
     
 the-player
    
    
    )
)

;GLOBAL PROCEDURES

;Remove an instrument from a player's collection
(define (remove player instrument)
  ((player 'remove) instrument)
)

;Return the items in the player's collection owned by owner
(define (collection player owner)
  ((player 'collection) owner)
  )

;Add an item to a players collection
(define (acquire object instrument)
((object 'acquire) instrument)
  )


;LIBRARY

(define (a-library)
  (let (
        (the-stock nil) ;Unloaned items
        (the-loans nil) ;Loaned items
       )
(define (the-library op)
  (cond ((eq? op 'acquire)    (lambda (i)   (acquire-instrument i)))
        ((eq? op 'lend)       (lambda (t p) (lend-instrument t p)))
        ((eq? op 'return)     (lambda (i)   (return-instrument i)))
        (else (error "the-library - operation not defined: " op))
        )
  )
    
  (define (acquire-instrument instrument)
    
  ;Check the instrument isnt owned already
  (define (check-for-owner i)
  (if (eq? (owner i) #f) 
      (begin
        (set-owner i the-library) ;set the owner to be this library
        (add-to-stock i)
        #t)
  #f)
  )
  ;Add the instrument to the stock  
  (define (add-to-stock i)  
    (set! the-stock (cons i the-stock))
    )
   (check-for-owner instrument) 
  )
    
    
(define (lend-instrument search-type player) ;lend the instrument, update stock, update loans
    
  (define (assign-item search-type player stock)  
    (cond
      ((null? stock) nil)
      ((eq? (type (car stock)) search-type) 
       (begin
       (update-stock (car stock)) ;(update-stock (the instrument to loan)
       (acquire player (car stock)) ; call the players aquire (the instrument)
       (set-loan player (car stock)) ; include the instrument and the player in the-loans
       (cdar the-loans) ; the newly loaned instrument
       ))
      (else (assign-item search-type player (cdr stock)))
      )
    )
    
  (define (set-loan player item);add the pair (player . instrument) to the-loans
  (set! the-loans (cons (cons player item) the-loans))
  )
    
(define (update-stock instrument) ;remove the item from the the-loans
  
(define (remove-stock stock instrument);remove the item from the-stock variable
  (cond
    ((null? stock) nil)
    ((not (eq? (car stock) instrument)) (cons (car stock) (remove-stock (cdr stock) instrument)))
    (else (remove-stock (cdr stock) instrument))
  )
)
  
(set! the-stock (remove-stock the-stock instrument)) ;set the stock to reflect the item has been removed
  
) 
       
  (assign-item search-type player the-stock) ;lend-item initial procedure
)
    
    
(define (return-instrument instrument)

(define (update-loans loans instrument);remove the requested loan from the-loans
  (cond
    ((null? loans) nil)
    ((not (eq? (cdr (car loans)) instrument)) (cons (car loans) (update-loans (cdr loans) instrument)))
    (else (update-loans (cdr loans) instrument))
))
  
(define (find-borrower loans instrument);find the borrower of the instrument that is being returned
  (cond
   ((null? loans) nil)
   ((eq? (cdr (car loans)) instrument) (caar loans) )
   (else (find-borrower (cdr loans) instrument))
   ))

(cond                                                             ;body of return-instrument
     ((equal? (update-loans the-loans instrument) the-loans) #f) 
     ((not(eq? (owner instrument) the-library)) #f)
(else     
(begin
(let
    ((borrower (find-borrower the-loans instrument)) )
(remove (find-borrower the-loans instrument) instrument)
(set! the-loans (update-loans the-loans instrument))
(set-owner instrument #f)
(acquire-instrument instrument)
 borrower))))
    
 )   
  the-library
  )
)  

;Lend any object of the type to the player  
(define (lend object type player)
  ((object 'lend) type player)
 )

;Return the instrument from the correct owner without specifying
(define (return object instrument)
 ((object 'return) instrument)
)



;HIRE SHOP

(define (a-shop)
(let
     (
     (shop-library (a-library)) ;inherit procedures from a-library
     (the-accounts nil) ;customer accounts for lending
     )
  (define (the-shop op)
  (cond ((eq? op 'acquire)    (lambda (i)   (acquire-shop i)))
        ((eq? op 'lend)       (lambda (t p) (add-loan (lend-shop t p) t p))) ;lend the item and add the loan to the players account
        ((eq? op 'return)     (lambda (i)   (return-shop i)))
        ((eq? op 'owes)       (lambda (p)   (owes p))) ;return the account balance
        ((eq? op 'pay)        (lambda (a p) (pay a p)));add the amount specified to the correct account
        (else (error "the-shop - operation not defined: " op))
        )
    )
;Same functionality as library acquire  
(define (acquire-shop i)
  (if (eq? (owner i) #f)
  (begin 
    (acquire shop-library i)
    (set-owner i the-shop)
    #t)
    #f)
  )
;sets the owed money to 10% of the instruments value  
(define (add-loan loan type player)
 (cond
   ((null? loan) #f)
   (else 
   (begin
   (set-cdr! (check-account player) (+ (* (value loan) 0.1) (cdr (check-account player))))
   (+ (* (value loan) 0.1))
   ))))
  
 (define (lend-shop type player)
   (lend shop-library type player)
   ) 
  
 ;Changes the owner to the shop-library and returns the instrument 
 (define (return-shop i)
 (begin
 (set-owner i shop-library)  
 (return shop-library i))
   )
  
(define (check-account player)
;Does the account exist in accounts?  
 (define (account-exists? player accounts)
  (cond 
   ((null? accounts) (new-account player) )
   ((eq? (caar accounts) player) (car accounts))
   (else (account-exists? player (cdr accounts)))
 ))
;If not, add a new account  
 (define (new-account player)
 (begin  
 (set! the-accounts (cons (cons player 0) the-accounts))
 (account-exists? player the-accounts) ;The account does exist now. Check it.
 ))
  
 (account-exists? player the-accounts)
)
         
  
  
(define (owes player)
 (cdr (check-account player))
)

;Take away the amount payed from the owed value  
(define (pay amount player)
(cond
((and (number? amount) (< 0 amount));Validate
(begin  
(set-cdr! (check-account player) (- (cdr (check-account player)) amount)) ;CDR of the account is the amount owed
(cdr (check-account player))))
(else (error "the-shop - not a valid amount to pay: " amount))
))
                                
  the-shop
  )
         
)

;How much a player owes - 0 by default
(define (owes shop player)
  ((shop 'owes) player)
  )
;Add money to an account - everyone can deposit money in an account,
(define (pay shop amount player)
  ((shop 'pay) amount player)
)

Examples:

Each line is sent to the scheme interpreter, the -> denotes the interpreter's response


Instrument examples

(define grand-piano (an-instrument ‘piano 10000)) -> #t
(define my-violin (an-instrument ‘violin 200)) -> #t
(define violin (an-instrument 10 ‘violin)) -> Error: an-instrument - not a value: violin
(define violin (an-instrument ‘violin -12))-> Error: an-instrument - not a positive value: -12
(set-owner ‘Mike grand-piano)-> #t
(owner grand-piano)-> Mike
(value grand-piano) -> 10000
(value my-violin)-> 200
(type grand-piano)-> piano
(type violin) -> violin
(type ‘Mike)-> Error: procedure: expected procedure, given: Mike; arguments were: type


Player Examples
(define Peter (a-player)) (define Anna (a-player))
(acquire Peter Guitar) -> #t
(acquire Guitar Peter) -> Error: the-instrument - operation not defined: acquire
(acquire Guitar Peter) -> #f
(acquire Drums Peter) -> #t
(set-owner Flute Peter) -> #t
(acquire Flute Anna) -> #t
(acquire Violin Anna) -> #t
(collection Peter Peter) -> (#<procedure:the-instrument> #<procedure:the-instrument>)
(map type (collection Peter Peter)) -> (Drums Guitar)
(remove Peter Drums) -> #t
(map type (collection Peter Peter)) -> (Guitar)
(map type (collection Anna Anna)) -> (Flute)

Library
Examples
(set-owner Peter Kazoo) -> #t
(acquire Library Drum) -> #t
(acquire Library Flute) -> #t
(acquire Library Kazoo) -> #f
(lend Library Peter Drum) -> #<procedure:Drum>
(lend Library Anna ‘Drum) -> ()
(lend Library Peter ‘Flute) -> #<procedure:Flute>
(collection Peter Library) -> (#<procedure:Flute> #<procedure:Drum>)
(return Library Flute) -> #<procedure:Peter>
(collection Peter Library) -> ( #<procedure:Drum>)
(return Library Flute) -> #f

Shop Examples
(owes Anna) -> 0
(lend Shop ‘Flute Anna) -> #t
(owes Anna) -> 10
(pay Shop -25 Peter) -> Error : the-shop - not a valid amount to pay: -25
(pay Shop 100 Peter) -> -100
(return Shop Flute) -> #t
(lend Shop ‘Flute Anna) -> #t
(owes Anna) -> 20

This post has been edited by Simown: 15 August 2010 - 02:16 PM

[Raynes]

I wrote a brief Lisp style guide http://www.dreaminco...sp-style-guide/ that might be helpful to some of you newer Lispers.

@Simown It's not a good idea to put closing parens on their own line. While it may seem easier to read initially, it'll make any experienced Lisper's eyes bleed. Parentheses don't serve the same purpose that curly brackets do in Java and C++. Stack them on the end. The only purpose they serve on their own lines is to create unnecessary line noise.

I'm not trying to be a dick to you. Only trying to help you out. <3

[Simown]

Raynes, on 15 August 2010 - 02:54 PM, said:

I wrote a brief Lisp style guide http://www.dreaminco...sp-style-guide/ that might be helpful to some of you newer Lispers.

@Simown It's not a good idea to put closing parens on their own line. While it may seem easier to read initially, it'll make any experienced Lisper's eyes bleed. Parentheses don't serve the same purpose that curly brackets do in Java and C++. Stack them on the end. The only purpose they serve on their own lines is to create unnecessary line noise.

I'm not trying to be a dick to you. Only trying to help you out. <3

Noted, I am not an "experenced Lisper" by any means.

This is correct?:

    (define (type? t)
      (cond 
            ((not (symbol? t)) (error "an-instrument - type not a symbol: " t))
            (else #t )))        

Edit: You just answered my question after I viewed your link

I was actually taught to space brackets out like that when learning Scheme, I hope I didn't pick up many other bad habits . Thanks for the link.

This post has been edited by Simown: 15 August 2010 - 04:17 PM

[Raynes]

It's not too hard to pick up weird formatting habits when you're using a generic editor that doesn't have specialized formatting settings for Lisp like most Emacs modes. That formatting is fine except that you indented too far after (cond. You probably only want to indent two spaces after cond so that your example looks like this:

(define (type? t)
  (cond 
    ((not (symbol? t)) (error "an-instrument - type not a symbol: " t))
    (else #t )))        

Otherwise, you're doing fine. Anyway, nice work on the submission, formatting aside. I just have to nitpick.