LispForum

Code: Select all

(defparameter *template* "Action-Template.java")                                      
(defparameter *sports* "sports.csv")
(defparameter *action-folder* "actions/")
(defparameter *action-class* ".java")
(defparameter *template-holder* "#NAME#")

(defun load-file-ms (file)
  "Loads the single lines of the template file into a list."
  (with-open-file (stream file :direction :input)
     (loop for line = (read-line stream nil nil)
           and line-count from 0
        while line
        collect line into lines
        finally (return (values lines line-count)))))

(defun load-file-os (file)
  "Returns the whole content of the file in one string."
  (with-open-file (stream file)
    (let* ((len (file-length stream))
           (data (make-string len)))
      (values data (read-sequence data stream)))))

(defun save-file(file content)
  "Save the content in the given file."
  (with-open-file (stream file :direction :output)
    (print (output content) stream)))

(defun replace-all (string part replacement &key (test #'char=))
  "Returns a new string in which all the occurences of the part 
  is replaced with replacement. !! For long strings, this version
  is notptimized!! 
  This code is from: http://cl-cookbook.sourceforge.net/strings.html"
  (with-output-to-string (out)
    (loop with part-length = (length part)
            for old-pos = 0 then (+ pos part-length)
            for pos = (search part string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                              :start old-pos
                              :end (or pos (length string)))
            when pos do (write-string replacement out)
            while pos)))

(defun clean(string)
  "Replaces bad characters in the given string."
  (setq string (replace-all string " " "_"))
  (dolist (toreplace '("?" "/" "(" ")" "," ".")) 
    (setq string (replace-all string toreplace "")))
  (dolist (toreplace '("-" "__"))
    (setq string (replace-all string toreplace "_")))
  string)

(defun create-classes()
  "Replaces a template string in the template file with another
  string and stores the result in a file that has the name of
  the replacement string."
  (let ((sports (load-file-ms *sports*))
        (jclass (load-file-os *template*)))
      (dolist (item sports) (create-sport jclass (clean item)))))

(defun create-sport (template item)
  "Save the template in a file and replaces the occurence of the
  *template-holder* by the item."
  (save-file (concatenate 'string *action-folder* item *action-class*) (replace-all template *template-holder* item)))

Code: Select all

(defconstant +sports+ (sort '("baseball" "hockey" "badminton" "poker" "go" "monopoly") #'> :key #'length))
(defparameter *replace-str* "#NAME#")

(defvar *template*) ;; Holds the current template string
(defvar *markers*)  ;; holds a list of replacable string start locations
(defvar *replace-len*) ;; holds the length of the replacable strings.

(defun load-template () (setf *template* "#NAME# is a sport where players play #NAME#. Enjoy an exciting game of #NAME#."))

(defun prepare-markers ()
  (setf *replace-len* (length *replace-str*))
  (setf *markers* (loop with position = 0
		        for nextmarker = (position #\# *template* :test #'char= :start position)
		        while nextmarker
		        if (string-equal *template* *replace-str* :start1 nextmarker
					 :end1 (min (+ nextmarker *replace-len*) (length *template*)))
		        collect nextmarker
		        do (setf position (1+ nextmarker)))))

(defun grow-template ()
  ;; Grow template into a new string inserting the first sport into every occurance of *replace-str*
  (let* ((diff (- (length (car +sports+)) *replace-len*))
	 (new (make-string (+ (* (length *markers*) diff) (length *template*)))))
    (loop with src = 0
          with dest = 0
          for marker in *markers*
	  do (replace new *template* :start1 dest :start2 src :end2 marker)
	  do (incf dest (- marker src))
	  do (replace new (car +sports+) :start1 dest)
	  do (incf dest (length (car +sports+)))
	  do (setf src (+ marker *replace-len*))
	  finally (replace new *template* :start1 dest :start2 src))
    (setf *replace-len* (length (car +sports+)))
    (setf *template* new)
    (loop for m on (cdr *markers*) ;; Update the markers to refer to our new larger template.
	  do (map-into m #'(lambda (v) (+ v diff)) m))))

(defun process-template (true-length new-value)
  (loop for m on *markers*
        with diff = (- *replace-len* (length new-value))
        do (replace *template* *template* :start1 (car m) :start2 (+ (car m) diff) :end2  true-length)
        do (replace *template* new-value :start1 (car m))
        do (map-into (cdr m) #'(lambda (v) (- v diff)) (cdr m))
        do (decf true-length diff))
  (setf *replace-len* (length new-value))
  true-length)
 
(defun output-sport (length name) (format t "~%~s: " name) (write-sequence *template* *standard-output* :end length))

(defun create-classes ()
  (load-template)
  (prepare-markers)
  (grow-template)
  (let ((true-length (length *template*)))
    (output-sport true-length (car +sports+))
    (dolist (sport (cdr +sports+))
      (setf true-length (process-template true-length sport))
      (output-sport true-length sport))))

;; output
"badminton": badminton is a sport where players play badminton. Enjoy an exciting game of badminton.
"baseball": baseball is a sport where players play baseball. Enjoy an exciting game of baseball.
"monopoly": monopoly is a sport where players play monopoly. Enjoy an exciting game of monopoly.
"hockey": hockey is a sport where players play hockey. Enjoy an exciting game of hockey.
"poker": poker is a sport where players play poker. Enjoy an exciting game of poker.
"go": go is a sport where players play go. Enjoy an exciting game of go.

Code: Select all

;; Heres the original code, slightly modified to be easily compared too.

(defun replace-all (string part replacement &key (test #'char=))
  "Returns a new string in which all the occurences of the part 
  is replaced with replacement. !! For long strings, this version
  is notptimized!! 
  This code is from: http://cl-cookbook.sourceforge.net/strings.html"
  (with-output-to-string (out)
    (loop with part-length = (length part)
            for old-pos = 0 then (+ pos part-length)
            for pos = (search part string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                              :start old-pos
                              :end (or pos (length string)))
            when pos do (write-string replacement out)
            while pos)))

(defun create-sport (item)
  "Save the template in a file and replaces the occurence of the
  *template-holder* by the item."
  (replace-all *template* *replace-str* item))


(defun create-classes-orig()
  "Replaces a template string in the template file with another
  string and stores the result in a file that has the name of
  the replacement string."
  (load-template)
  (dolist (sport +sports+) (create-sport sport)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TIMING

(defun output-sport (length name) (declare (ignore length name)) nil)   ;; Neither test does any output.
(defun load-template () (setf *template* "#NAME# is a sport where players play #NAME#. Enjoy an exciting game of #NAME#."))

(time (dotimes (x 1000) (create-classes)))
(time (dotimes (x 1000) (create-classes-orig)))

;; NEW
Evaluation took:
  0.072 seconds of real time
  0.059991 seconds of total run time (0.059991 user, 0.000000 system)
  83.33% CPU
  191,298,856 processor cycles
  1,359,128 bytes consed

;; ORIG
Evaluation took:
  0.087 seconds of real time
  0.076988 seconds of total run time (0.076988 user, 0.000000 system)
  88.51% CPU
  233,234,512 processor cycles
  5,521,656 bytes consed

;; Mine is slightly faster, and conses less. 

(defun load-template ()
  (setf *template* "#NAME# is a sport where players play #NAME#. Enjoy an exciting game of #NAME#.
Lets make #NAME# have a really big file thats more like a java file. #NAME# #NAME# #NAME# the more
times we use #NAME# the more work that needs to be done. I'm not sure how that will affect timing.

It might be interesting to have a large string with no #NAME# and another thats entirely #NAME#. 
In anycase, lets assume lets go on for 10 more lines so I'll have done a good test of #NAME# replacement.

Ten more lines... but what will I write about? I could write about the sport #NAME#, but since #NAME#
could be hockey, poker, or anything, I wouldn't know what to say.  Nintendo could be a sport, I mean
if ball room dancing, diving and #NAME# are sports than anything goes right?  I hope to see #NAME# in
the olympics in the future. 

6 more lines.  Can I make it, ... naw, lets just leave it at this.  6 additional lines is good enough 
for #NAME#."))

(time (dotimes (x 1000) (create-classes)))
(time (dotimes (x 1000) (create-classes-orig)))


;; NEW
Evaluation took:
  2.582 seconds of real time
  2.298650 seconds of total run time (2.296651 user, 0.001999 system)
  [ Run times consist of 0.014 seconds GC time, and 2.285 seconds non-GC time. ]
  89.04% CPU
  6,889,699,924 processor cycles
  19,386,288 bytes consed

;; ORIG
Evaluation took:
  0.930 seconds of real time
  0.821874 seconds of total run time (0.818875 user, 0.002999 system)
  [ Run times consist of 0.034 seconds GC time, and 0.788 seconds non-GC time. ]
  88.39% CPU
  2,480,776,628 processor cycles
  60,952,040 bytes consed