Showing posts with label lisp. Show all posts
Showing posts with label lisp. Show all posts

Friday, January 11, 2013

Fibonacci speed and exponential growth

For the fun of it I wrote a fibonacci algorithm in:
  • C
  • Lisp
  • Clojure
  • Python
and tested their execution speed.

The result is not surprising, and the chart below is a clear reminder that it's not the speed of the language, it's how good your algorithms perform (at least when exponential growth can be expected).

The slowness of the Clojure tests must be the JVM startup time. I know Clojure and Lisp can be compiled, here neither are.

Thar fibonacci algorithm used here are simple and recursive:

def fib(x):
    if x<=2: return 1
    return fib(x-1)+fib(x-2)

better algorithms for this exists, and i can highly recommend looking at the LiteratePrograms if you are interested in this: 

http://en.literateprograms.org/

Tuesday, August 28, 2012

Scan path example

Lisp example scanning a path and subpath for php files inside media or image folders, changed within the last 24 hours.

Shows off mail, command line, compiling and more.

(ql:quickload "cl-fad")
(ql:quickload "cl-smtp")
(ql:quickload "split-sequence")
(ql:quickload "command-line-arguments")
(ql:quickload :log4cl)

;
; helpers
;

(defmacro aif (test-form then-form &optional else-form)
    "Anaphoric Macro
    makes it possible to use value of if calculation without let assignment first"
    `(let ((it ,test-form))
        (if it ,then-form ,else-form)))

(defun find-part (part sequence)
    "Find part as as substring in sequence elements, return first occurence or nil
    (find-part \"abc\" (list \"x\" \"yabc\" \"z\")) ==> (list \"yabc\" \"z\")"
    (member part sequence :test (lambda (a b) (search a b))))

(defun get-cmdline-opt (name) 
    "Handle arguments like -x y -p w
    (get-cmdline-opt -x) => y"
    (second (member name  (command-line-arguments:get-command-line-arguments) :test 'equal )))

(defun split-and-lower (str)
    "Lowercase and split around / and return all but first item"
    (cdr (split-sequence:split-sequence #\/ (string-downcase str))))

(defun file-age-days (path)
 (/ (- (get-universal-time) (file-write-date path)) (* 60.0 60.0 24.0) ) )

;
; scanning
;


(defun file-scan (path)

 (let (files)

     (defun scan-files (path)
                    (if (null path ) 
                        (log:info "no path supplied")
            (cl-fad:walk-directory path 'check-file)))

     (defun check-file (pathname)
         (check-parts pathname (split-and-lower (namestring pathname))))

     (defun check-parts (pathname parts)
         (aif (find-part ".php" (cdr (find-part "media" parts)))
                        (prog ()
                            (if (< (file-age-days pathname) 20)
                                ;(format t "found ~a in ~a~&" it pathname)
                                (push (namestring pathname) files)
                            ))))

                (scan-files path)
                (return-from file-scan files)
 ))

(defun generate-report (files)
 (format nil "Suspect files found:
~% ~{ - ~a 
~% ~}" files))

(defun send-report (files recipient)
    " Accepts a list of filenames. Builds an apropriate mail and send it "
    (log:info "sending mail")
    (cl-smtp:send-email "mail.infoserv.dk"
        "msj@infoserv.dk" recipient
        "Suspicious files" (generate-report files)
        :extra-headers '(("Content-type" "text/html; charset=\"iso-8859-1\""))
        :authentication '("msj@infoserv.dk" "******")
        :port 366
       )
    )

;
; main
;

(defun main ()
    (aif (get-cmdline-opt "--path") 
        (send-report (file-scan it) "msj@infoserv.dk")
        (format t "supply a path using --path path")
     )
    (quit))

(log:config :daily "log.txt")
(main)

(defun compileme ()
    (sb-ext:save-lisp-and-die "scandir" :executable t :toplevel 'main :purify t))

Friday, August 10, 2012

Common Lisp error handling example

; Error  handling example.

(define-condition some-error (error)
    ((what :initarg :what :initform "something" :reader what))
    (:report (lambda (condition stream)
                        (format stream "Agh! ~@(~A~) error." (what condition))))
    (:documentation "Some-error condition."))

(defun ignore-some-error1 ()
 " Restart function "
 (print "some error 1")
 T)

(defun function-with-error ()
    " Test function which generate an error. Called directly this will start the debugger/repl. "
    (restart-case (error 'some-error :what "test")
          (use-value (value) value) ; first restart function
          (ignore-some-error1 () (ignore-some-error1)))) ; second restart function

(defun higher-function ()
    " This funtion calls a function which contains an error, but invokes the desired restart.
    Other higher-functions could select different restart or none at all, so the behaviour of 
    the function-with-error under error conditions is controlled on the higher-functions level. "
    (handler-bind ((some-error
                  #'(lambda (c)
                      (invoke-restart 'ignore-some-error1))))
                      (function-with-error )))