Category: Tutorials

In another post, I discussed how to build Chez Scheme from source for Debian 9 Stretch, here is how to setup SLIB.

git clone https://github.com/taktoa/slib.git
cp -fr slib /usr/share
cd /usr/local/lib
ln -sf /usr/share/slib .
chmod 777 /usr/share/slib
touch /usr/bin/chez
chmod 777 /usr/bin/chez
vim /usr/bin/chez

Edit the file /usr/bin/chez to be:

#! /usr/bin/scheme
(load "/usr/share/slib/chez.init")

Here is a bit of code I’ve been tinkering with, it’s a simple CSV parser in Scheme that I am using to parse Stock data so that I can back test trading strategies.

(define (csv->list file_name)
  (with-input-from-file file_name
	(lambda ()
	  (let reading ((chars '()) (rows '()) (cols '()))
		(let ((char (read-char)))
		  (cond
			((eof-object? char) (reverse rows))
			((char=? char #\newline)
			 (reading '() (cons 
					(reverse 
					  (cons (list->string (reverse chars)) cols)) 
					rows) '()))
			((char=? char #\,)
			 (reading '() rows
			   (cons (list->string (reverse chars)) cols)))
			(else
			  (reading (cons char chars) rows cols))))))))
(csv->list "D:/Projects/StockMarket/NASDAQ_20101105.txt")

The above is why I love Scheme. Such a succinct language.

How to design functions in Scheme

The above small function follows the basic function design pattern, we begin with the target or most significant goal state: EOF. What do we do?

((eof-object? char) (reverse rows))

We return the reverse of the rows. This is because cons prepends new elements. Now we could call (append) instead of (cons) but (append) has to find the end of the list each time, adding unnecessary overhead.

Our next goal, or major target is the end of line, or #\newline character.

((char=? char #\newline)
  (reading '() (cons 
    (reverse 
	(cons (list->string (reverse chars)) cols)) 
     rows) '()))

If the current char equals a new line, we need to:

  1. Produce the column value (newline works like comma)
  2. Prepend the column value to the lists (cols)
  3. Prepend the (reverse cols) list onto (rows)
  4. Recurse into (reading) with the new (rows) and ‘() for both chars and cols

The next goal state, is encountering a comma, or the delimiter:

((char=? char #\,)
    (reading '() rows
      (cons (list->string (reverse chars)) cols)))

In this case we need to recurse into (reading) with ‘() for chars, as well as prepending the (reverse) of (chars) stringified to (cols).

So I’ve picked up a new book, Introduction to Algorithms, 3rd ed. and I’ve decided to try implementing some of them as a practice using Scheme, specifically I’m using a vanilla install of Chez Scheme.

(define merge-sort
  (lambda (l A L R sw)
	(cond
	  ((and (null? L) (null? l)) (append A R))
	  ((and (null? R) (null? l)) (append A L))
	  (else
		(cond 
		  ((null? l)
		   (cond
			 ((and (null? A) (or (= sw 1) (= sw 0)))
			  (merge-sort 
				l 
				A 
				(merge-sort L '() '() '() 0) 
				(merge-sort R '() '() '() 0) 
				-1))
			 (else
		   		(if (<= (car L) (car R))
			 		(merge-sort 
					  l 
					  (append A (list (car L))) 
					  (cdr L) 
					  R 
					  sw)
			 		(merge-sort 
					  l 
					  (append A (list (car R))) 
					  L 
					  (cdr R) 
					  sw)))))
		  (else
			(if (= sw 0)
			  (merge-sort 
				(cdr l) 
				A 
				(append L (list (car l))) 
				R 
				1)
			  (merge-sort 
				(cdr l) 
				A 
				L 
				(append R (list (car l))) 
				0))))))))

(merge-sort '(85 6 43 33 21 9 1 3 22 84 85) '() '() '() 0)

So I’ve picked up a new book, Introduction to Algorithms, 3rd ed. and I’ve decided to try implementing some of them as a practice using Scheme, specifically I’m using a vanilla install of Chez Scheme.

(define isort 
    (lambda (l1 l2)
        (cond
            ((null? l1) l2)
            ((null? l2) (isort
                (cdr l1)
                (cons (car l1) l2)))
            ((<= (car l1) (car l2)) 
                (isort
                    (cdr l1)
                    (cons
                        (car l1)
                        l2)))
            ((> (car l1) (car l2))
                (isort
                    (cdr l1)
                    (cons 
                        (car l2) (isort 
                            (cons 
                                (car l1) 
                                '()) 
                            (cdr l2))))))))
(isort '(85 12 59 45 72 51) '())

Now that’s all fine and good, but we need ‘More Power’ as Tim the Toolman Taylor would say. I think it’d be nice if we could pass the function a comparator, so that we could do ascending and descending sorts.

(define isortf 
    (lambda (l1 l2 c1 c2)
        (cond
            ((null? l1) l2)
            ((null? l2) (isort
                (cdr l1)
                (cons (car l1) l2) c1 c2))
            ((apply 
                c1 (list 
                    (car l1) 
                    (car l2))) 
                (isortf
                    (cdr l1)
                    (cons
                        (car l1)
                        l2) 
                    c1 
                    c2))
            ((apply 
                c2 (list 
                    (car l1) (car l2)))
                (isortf
                    (cdr l1)
                    (cons 
                        (car l2) (isortf 
                            (cons 
                                (car l1) 
                                '()) 
                            (cdr l2) 
                            c1
                            c2)) 
                    c1
                    c2)))))

(isort '(3 4 2 1) '())
(isortf '(3 4 2 1) '() >= <)

When you write in Scheme, it all makes perfect sense to you. It looks hand crafted, like a fine old carving. But part of you knows it's probably completely incomprehensible to anyone else.

Oh well. At least I think it's beautiful.

Object composition is a design pattern, not syntactic sugar. Implementing a basic pattern of object composition in Lua is as trivial as it is powerful. It’s one of my preferred methods of applying general interfaces to stateful objects.

local function CreateObject(obj)
    obj.Clone = function(self,target)
        for k,v in pairs(self) do
            target[k] = v
        end
        return target
    end
    return obj
end
local function CreatePositionableObject(obj)
    obj = CreateObject(obj)
    local attrs = {"Position","Orientation"}
    for _,a in pairs(attrs) do
        obj["Set"..a] = function (self,x)
            self[string.lower(a)] = x
        end 
        obj["Get"..a] = function (self,x)
            return self[string.lower(a)]
        end 
    end
    obj.MoveTo = function(self,x,y,z)
        print("Moving",self:GetName(),"to",x,y,z)
        self:SetPosition({x,y,z})
    end
    return obj
end
local function CreatePlayer(obj)
    obj = CreatePositionableObject(obj)
    local attrs = {"Name","HitPoints","ID","Class","Team"}
    for _,a in pairs(attrs) do
        obj["Set"..a] = function (self,x)
            self[string.lower(a)] = x
        end 
        obj["Get"..a] = function (self,x)
            return self[string.lower(a)]
        end 
    end
    obj.FireAt = function(self,target)
        print(self:GetName(),"firing at",target:GetName())
    end
    return obj
end
local function CreateFakePlayer(obj)
    obj = CreatePlayer(obj)
    obj.MoveTo = function(self,x,y,z)
        print("Fake players can't actually move...")
    end
    obj.FireAt = function(self,target)
        print(self:GetName(),"can't shoot at",target:GetName())
    end
    return obj
end

local p1 = CreatePlayer({})
local p2 = CreateFakePlayer({})

p1:SetName("Player 1")
p2:SetName("Player 2")
p1:MoveTo(1,2,3)
p2:MoveTo(3,2,1)
p1:FireAt(p2)
p2:FireAt(p1)
print(p1:GetName() .. "'s position",p1:GetPosition()[1],p1:GetPosition()[2],p1:GetPosition()[3])
local p3 = p1:Clone({})
p3:SetName("Player 3")
p3:FireAt(p1)

This works for the simple reason that tables in Lua are object references, so changing them inside of a function has side effects. Because of this, it is always a good idea to only change tables being used as object via Getter/Setter functions so that it is easier to debug.

The above code creates a Player and a FakePlayer, the equivalent inheritance path would be Object > PositionableObject > Player > FakePlayer.

Note that self is a convention, not a keyword!