A Simple Banking System in Scheme(Example for Modularity)

(define (make-accumilator val)
 (lambda (x)
  (begin
   (set! val (+ val x))
   val
  )
 )
)


;#######----------Banking System----------##########;
;Procedure Usage Counter....

(define (make-monitered f)
 (define ctr 0)
 (define (increment) 
  (set! ctr (+ ctr 1))
 )
 (define (reset)
  (set! ctr 0)
 )
 (define (mf arg)
  (cond ((eq? arg 'how-many-calls?) ctr)
    ((eq? arg 'reset-count)   (reset) )
    (else (begin (increment) (f arg)))
  )
 )
mf)


;Password protected banking system...

(define (make-account password balance)
    (define ctr 0)
    (define (display-account-blkd x) "Account Blocked")
    (define (display-wrong-passwd x) "Wrong Password")
     (define (withdraw amount)
 (if (>= balance amount)
   (begin
     (set! balance (- balance amount))
     balance
   )
   (display "Sufficient balane not in the account...")
 )
      )

      (define (deposit amount)
   (begin
     (set! balance (+ balance amount))
     balance
   )
      )

      (define (main passwd transaction)
 (if (>= ctr 5)
   display-account-blkd
     (if (eq? passwd password)
      
       (begin
    (set! ctr 0)
    (cond ((eq? transaction 'deposit) deposit  )
   ((eq? transaction 'withdraw) withdraw  )
   (else (lambda (x) "Invalid Choice"))
    )
       )
       
       (begin
    (set! ctr (+ ctr 1))
  display-wrong-passwd
       )
     )
 )

      )
main);End of body of let...

Recursive Exchange Selection Sort in Scheme

;#######Exchange Selection Sort#################;;;;

;Function to find the smallest element in a list
(define (smallest L)
    (if (null? (cadr L))
 (car L)
 (smallest2 L (car L)) 
    )
)
(define (smallest2 L e)
     (if (null? L)
   e
 (if (< (car L) e)
     (smallest2 (cdr L) (car L))
     (smallest2 (cdr L) e)
 )
      )
)

;Function to swap an element 'e' in the list with 'new-e' if 'e' is there in the list
(define (swap L e new-e)
  (if (null? L)
      L
    (if (= e (car L))
 (cons new-e (cdr L))
 (cons (car L) (swap (cdr L) e new-e))
    )

  )
)

(define (exchange-sort L)
    (if (or (null? L) (null? (cdr L)))
   L
 (cons (smallest L) (exchange-sort (swap (cdr L) (smallest L) (car L))))
    )

)

Recursive Insertion Sort in Scheme

;##########Insertion Sort##################
;Function to insert an element into a sorted list
(define (insert-into L e)
  (if (null? L)
      (list e)
      (if (< e (car L))
   (cons e L)
   (cons (car L) (insert-into (cdr L) e))
      )
  )

)

;This function keeps on adding each element of the list to 'new-L' which will be a sorted list
(define (insertion-sort2 L new-L)
      (if (null? L)
   new-L
   (insertion-sort2 (cdr L) (insert-into new-L (car L)))
      )

)

(define (insertion-sort L)
   (if (or (null? L) (null? (cdr L)))
 L
 (insertion-sort2 L '())
   )
)

Recursive Bubble Sorting in Scheme

;#########Bubble Sorting################;;

;This function when executed once, the lagest element reaches the end of the list
(define (loop L)
  (if (null? (cdr L))
      L
      (if (< (car L) (cadr L))
   (cons (car L) (loop (cdr L)))
   (cons (cadr L) (loop (cons (car L) (cddr L))))
      )
  )
)

;Funtion to return the last value in a list
(define (end-value L)
    (cond ((null? L) #f)
   ((null? (cdr L)) (car L))
   (else (end-value (cdr L)))
    )
)

;Function to return the list, removing the last element
(define (except-last L)
    (cond ((null? L) #f)
   ((null? (cdr L)) '() )
   (else (cons (car L)(except-last (cdr L))))
    )

)

;Function add an element to the end of a list
(define (add-to-end L e)
    (append L (list e))
)

(define (bubble-sort L)
    (if (or (null? L) (null? (cdr L)))
   L
 (add-to-end (bubble-sort (except-last (loop L)))
             (end-value (loop L))
 )
    )
)

Longest Path in a directed graph (Scheme Program)

;Function that returns list of all edges of a given vertex...
;Eg when the graph G given below is passed and v=1 it will return (2 5)
(define (edges v G)
 (if (null? G)
  '()
  (if (= (caaar G) v)
   (cadar G)
   (edges v (cdr G))
  )
  
 )
)

;To compare a list of vertices and then to retun the longest path among them...
(define (longer-one v-L G long-path)
      (if (null? v-L)
   long-path
   (if (< (length long-path) (length (cons (car v-L) (longest-path (car v-L) G))))
    (longer-one (cdr v-L) G (cons (car v-L) (longest-path (car v-L) G)))
    (longer-one (cdr v-L) G long-path)
   )
      )
)


;Function to find the longest path...
(define (longest-path v G)
 (if (null? (edges v G))
       '()
       (if (null? (cdr (edges v G)) )
  (cons (car (edges v G)) (longest-path (car (edges v G)) G))
  (longer-one (edges v G) G (cons (car (edges v G)) (longest-path (car (edges v G)) G)))
       )
 )
)

(define (find_path v G)
 (cons v (longest-path v G))
)

(define G
  (list
    (list (list 1) (list 2 5))
    (list (list 2) (list 3))
    (list (list 3) (list 4))
    (list (list 4) (list 9))
    (list (list 5) (list 6))
    (list (list 6) (list 7))
    (list (list 7) (list 8))
    (list (list 8) '() )
    (list (list 9) '() )

  )
)  

(define G2
  (list
    (list (list 1) (list 3))
    (list (list 3) (list 5 8))
    (list (list 5) (list 9))
    (list (list 8) (list 4))
    (list (list 4) (list 7 10))
    (list (list 7) (list 6))
    (list (list 6) (list 9))
    (list (list 9) '() )
    (list (list 10) '() )

  )
)

Implementing Queue in Scheme

;;#######Implimenting Queue#########
(define (make-queue)
 (define p (cons '() '() ) )
 (cons p p)
)

;Checks whether a queue is empty
(define (null-queue? q)
 (and (eq? (front q) (rear q)) (eq? (car (front q)) '() ))
)

(define (front q)
 (car q)
)

(define (rear q)
 (cdr q)
)

(define (push q e)
 (define p (cons e '()))
 (if (null-queue? q)
  (begin (set-car! q p)
   (set-cdr! q p)
  )
  (begin
   (set-cdr! (rear q) p)
   (set-cdr! q p)
  )

 )
)

(define (pop q)
 (define x 0)
 (if (null-queue? q)
  'Empty
  (if (and (eq? (front q) (rear q))  (eq? '() (cdr (front q)))   )
   (begin
    (set! x (car (front q)))
    (set-car! (front q) '() )
    x
   ) 
   (begin
    (set! x (car (front q)))
    (set-car! q (cdr (front q)) )
    x
   ) 

  )
 )

)

Binary Search Tree in Scheme

;Impliementing tree. and thus binary searching.....


;Checks whether the given node is a leaf...
(define (leaf? tree)
 (if (and (null? (left-branch tree) (null? right-branch tree)))
   #t
   #f
 )
)
;Checks wheter the tree has only left branch
(define (left-only? tree)
 (if (and (null? (right-branch tree)) (not (null? (left-branch tree))))
   #t
   #f
 )

)

;Checks wheter the tree has only left branch
(define (right-only? tree)
 (if (and (null? (left-branch tree)) (not (null? (right-branch tree))))
   #t
   #f
 )

)


;When node, left branch and right branch of the tree are passed as arguements, 
;the function will make and return the tree
(define (make-tree node left-branch right-branch)
    (list node left-branch right-branch)
)


;This function returns the node element of a given tree
(define (node tree)
    (car tree)

)

;This function returns the left branch(subtree) of a given tree
(define (left-branch tree)
    (cadr tree)
)


;This function returns the right branch(subtree) of a given tree
(define (right-branch tree)
    (caddr tree)
    
)


;This function will insert an element into a tree and returns the new tree
(define (insert e tree)
    (cond
        ((null? tree) (make-tree e '() '()));If the passed tree is null then a new tree of the form (e '() '())
                                            ;will be created
                        
        ((= e (node tree)) tree) ; If the node of the element is eqaual to the elemented to be inserted
                                    ; Then there is no need for inserting and the previous tree will be returned.
    
        ;If the element is greater than the node element, then the element shud be inserted 
        ;somewhere in the right-branch        
        ((> e (node tree)) 
            (make-tree (node tree) (left-branch tree) (insert e (right-branch tree)))
        ) 
    
        ;If the element is greater than the node element, then the element shud be inserted 
        ;somewhere in the left-branch  
        ((< e (node tree))
    
            (make-tree (node tree) (insert e (left-branch tree)) (right-branch tree))
    
        )
    
    
    )
)

;This function is called to make a tree from a given list..
;It will call the function set->tree2 with cdr of set and a new tree with root node (car set) as arguement
(define (set->tree set)
    (if (null? set)
        '()
        (set->tree2 (cdr set) (make-tree (car set) '() '()))    
    
    )
)


;This functon will extract each element of set and insert it into the given tree
(define (set->tree2 set tree)
    (if (null? set)
        tree
        (set->tree2 (cdr set) (insert (car set) tree))
    )

)


;Searching an element in a binary search tree..
(define (search-tree e tree)
    (cond
        ((null? tree) #f) ; If the set is null result is boolean false
        ((= (node tree) e) #t) ; If the node of tree equals e, the result is true
        ((> e (node tree)) (search-tree e (right-branch tree))); if e is greater than node element, it shud be searched in right-branch
        ((< e (node tree)) (search-tree e (left-branch tree))) ; if e is lesser than node element, it shud be searched in right-branch
        
        
    )
    
)


;The function which user calls for searching element in a set,
;It will call the functions make the set to a binary search tree and then to perform binary search
(define (search e set)

    (search-tree e (set->tree set))
    
)

;Inserting tree1 into ertreme right of tree2(function used while deletion...)..

(define (join-trees tree1 tree2)
 (if (null? tree2)
    tree1
    (make-tree (node tree2) (left-branch tree2) (join-trees tree1 (right-branch tree2)))
 )
)

;Function to delete an element from a tree..

(define (delete e tree)
 (if (null? tree)
  '()

  ;If the tree is not null then....
  (cond  ((= e (node tree))
     (cond ((leaf? tree)
        '()
      )
      
      ((left-only? tree)
       (left-branch tree)
      
      )
      ((right-only? tree)
       (right-branch tree)
      
      )
      (else 
       (join-trees (right-branch tree) (left-branch-tree)      
       )
      )
     )
   )
   ((> e (node tree)) 
    (make-tree (node tree) (left-branch tree) (delete e (right-branch tree)) )
   )
   ((< e (node tree)) 
    (make-tree (node tree) (delete e (left-branch tree)) (right-branch tree)  )
   )
  )

  
 )


)


;function for sorting..
(define (sort-tree tree)
 (if (null? tree)
  '()
  (append (sort-tree (left-branch tree)) (list (node tree)) (sort-tree (right-branch tree)))
 )

)

(define (tree-sort set)
 (sort-tree (set->tree set))
)

(define mylist (list 7 4 9 1 2 10 11 15 5))
(define mytree (set->tree mylist))
;mytree

Library Management System in CPP

Please visit the link below to download my Secondary school computer science project, A Library Management System in C++.

http://www.athena.nitc.ac.in/~muhammedyazar_bcs10/My%20Programs/C_CPP/Library%20Management%20System/

Feel free to download it, use it, improve the code and share it..... I do support FOSS philosophy always