Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

revert Henry Baker's contribution of 2013 July, this breaks test code #36

Merged
merged 2 commits into from
Jun 24, 2014
Merged

revert Henry Baker's contribution of 2013 July, this breaks test code #36

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
19a93dc
Merge pull request #33 from snozawa/assoc_handle_attention_to_adequat…
snozawa Jun 19, 2014
2da6078
revert Henry Baker's contribution of 2013 July, this breaks test code…
k-okada Jun 23, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 1 addition & 24 deletions lisp/geo/primt.l
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -701,7 +701,7 @@ hedron is an icosahedron or a gdome of lower level"

;;

#|

(defun make-body-from-vertices (face-vertices &optional (klass *body-class*))
; face-vertices=(list #f(x1 y1 z1) #f(x2 y2 z2) ...) ...
#|(setq a
Expand All @@ -728,29 +728,6 @@ hedron is an icosahedron or a gdome of lower level"
(setq bod (instance *body-class* :init :faces (nreverse faces)))
(send bod :csg (list (cons :body-from-vertices face-vertices)))
bod) )
|#
;; 2014.5.21 add Henry Baker's contribution of 2013.8.31
(defun make-body-from-vertices (face-vertices &optional (klass *body-class*))
; face-vertices=(list #f(x1 y1 z1) #f(x2 y2 z2) ...) ...
(let* ((vlist (mapcar #'list
(remove-duplicates
(apply #'append face-vertices)
:test #'equal)))
(vhash (make-hash-table :size (* 2 (length vlist)) :test #'equal))
faces bod)
(dolist (vlist-entry vlist) ; Populate hash table.
(or (gethash (car vlist-entry) vhash)
(setf (gethash (car vlist-entry) vhash) vlist-entry)))
(dolist (fverts face-vertices)
(let ((fvlist))
(dolist (fv fverts)
;; (push (assoc fv vlist) fvlist)
;; (push (assoc fv vlist :test #'equal) fvlist) ; *** Too slow !!! ***
(push (gethash fv vhash) fvlist))
(push (make-face-from-vertices (nreverse fvlist)) faces)) )
(setq bod (instance *body-class* :init :faces (nreverse faces)))
(send bod :csg (list (cons :body-from-vertices face-vertices)))
bod) )



Expand Down
20 changes: 0 additions & 20 deletions lisp/l/common.l
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -620,29 +620,9 @@ if pos is bigger than the length of list, item is nconc'ed at the tail"
((memq (car l) (cdr l)) (unique (cdr l)))
(t (cons (car l) (unique (cdr l))))))

#|
(defun remove-duplicates (seq &key (test #'eq) (test-not) (key #'identity)
(start 0) (end 1000000))
(system::raw-remove-duplicates seq test test-not key start end))
|#
;; 2014.5.21 add Henry Baker's contribution of 2013.7.22, 2013.8.31
(defun remove-duplicates (seq &key (key #'identity)
(test #'eq) (test-not)
(start 0) (end (length seq)))
(if (and (or (eq test #'eq) (eq test #'eql) (eq test #'equal))
(> end 100))
(let* ((htab (make-hash-table :size (* 2 (length seq)) :test test)))
(let* ((res
(remove-if
#'(lambda (k)
(let* ((v (gethash k htab)))
(unless v (setf (gethash k htab) t))
v))
seq
:start start :end end :key key)))
res))
(system::raw-remove-duplicates seq test test-not key start end)))


(defun extream (seq test &optional (key #'identity))
(if (null seq)
Expand Down