From alendvai at common-lisp.net Fri Mar 2 08:14:53 2012 From: alendvai at common-lisp.net (Attila Lendvai) Date: Fri, 02 Mar 2012 00:14:53 -0800 Subject: [alexandria.git] updated branch master: e1c8ede Added support for copy-stream for START and END keyword arguments. Message-ID: The branch master has been updated: via e1c8ede0ebaac5026c7dd2e8a1cc450a58455ae5 (commit) from 485544d4feb13d3f463f54a5605b3a480bc49046 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit e1c8ede0ebaac5026c7dd2e8a1cc450a58455ae5 Author: Attila Lendvai Date: Fri Mar 2 14:13:48 2012 +0600 Added support for copy-stream for START and END keyword arguments. ----------------------------------------------------------------------- Summary of changes: alexandria.asd | 2 +- io.lisp | 38 +++++++++++++++++++++++++++++++++----- 2 files changed, 34 insertions(+), 6 deletions(-) diff --git a/alexandria.asd b/alexandria.asd index a7efd8e..5277631 100644 --- a/alexandria.asd +++ b/alexandria.asd @@ -47,7 +47,7 @@ the following constraints: (:file "strings" :depends-on ("package")) (:file "conditions" :depends-on ("package")) (:file "hash-tables" :depends-on ("package")) - (:file "io" :depends-on ("package" "macros" "lists")) + (:file "io" :depends-on ("package" "macros" "lists" "types")) (:file "macros" :depends-on ("package" "strings" "symbols")) (:file "control-flow" :depends-on ("package" "definitions" "macros")) (:file "symbols" :depends-on ("package")) diff --git a/io.lisp b/io.lisp index 59d6a8c..637c9be 100644 --- a/io.lisp +++ b/io.lisp @@ -107,17 +107,45 @@ unless it's NIL, which means the system default." (defun copy-stream (input output &key (element-type (stream-element-type input)) (buffer-size 4096) (buffer (make-array buffer-size :element-type element-type)) + (start 0) end finish-output) "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have compatible element-types." - (let ((bytes-written 0)) + (check-type start non-negative-integer) + (check-type end (or null non-negative-integer)) + (check-type buffer-size positive-integer) + (when (< end start) + (error "END is smaller than START in ~S" 'copy-stream)) + (let ((output-position 0) + (input-position 0)) + (unless (zerop start) + ;; FIXME add platform specific optimization to skip seekable streams + (loop + :while (< input-position start) + :for bytes-read = (read-sequence buffer input + :end (min (length buffer) + (- start input-position))) + :do (progn + (when (zerop bytes-read) + (error "Could not read enough bytes from the input to fulfill the START requirement in ~S" 'copy-stream)) + (incf input-position bytes-read)))) + (assert (= input-position start)) (loop - :for bytes-read = (read-sequence buffer input) - :until (zerop bytes-read) + :while (or (null end) + (< input-position end)) + :for bytes-read = (read-sequence buffer input + :end (when end + (min (length buffer) + (- end input-position)))) :do (progn + (when (zerop bytes-read) + (if end + (error "Could not read enough bytes from the input to fulfill the END requirement in ~S" 'copy-stream) + (return))) + (incf input-position bytes-read) (write-sequence buffer output :end bytes-read) - (incf bytes-written bytes-read))) + (incf output-position bytes-read))) (when finish-output (finish-output output)) - bytes-written)) + output-position)) -- Alexandria hooks/post-receive From alendvai at common-lisp.net Wed Mar 7 03:40:02 2012 From: alendvai at common-lisp.net (Attila Lendvai) Date: Tue, 06 Mar 2012 19:40:02 -0800 Subject: [alexandria.git] updated branch master: 95f8d22 Fix COPY-STREAM when called without an explicit END argument. Message-ID: The branch master has been updated: via 95f8d2213e3c4be345f0bdf4d06ab82ade67d898 (commit) from e1c8ede0ebaac5026c7dd2e8a1cc450a58455ae5 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 95f8d2213e3c4be345f0bdf4d06ab82ade67d898 Author: Zach Beane Date: Wed Mar 7 09:35:42 2012 +0600 Fix COPY-STREAM when called without an explicit END argument. ----------------------------------------------------------------------- Summary of changes: io.lisp | 3 ++- 1 files changed, 2 insertions(+), 1 deletions(-) diff --git a/io.lisp b/io.lisp index 637c9be..ee89cb0 100644 --- a/io.lisp +++ b/io.lisp @@ -115,7 +115,8 @@ compatible element-types." (check-type start non-negative-integer) (check-type end (or null non-negative-integer)) (check-type buffer-size positive-integer) - (when (< end start) + (when (and end + (< end start)) (error "END is smaller than START in ~S" 'copy-stream)) (let ((output-position 0) (input-position 0)) -- Alexandria hooks/post-receive From nsiivola at common-lisp.net Fri Mar 30 15:00:49 2012 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 30 Mar 2012 08:00:49 -0700 Subject: [alexandria.git] updated branch master: 4119ce8 Revert "generic MEAN and MEDIAN, new function DISPLACE-ARRAY" Message-ID: The branch master has been updated: via 4119ce8ae6baf661d426a09e44d07c262dc55b9a (commit) from 95f8d2213e3c4be345f0bdf4d06ab82ade67d898 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4119ce8ae6baf661d426a09e44d07c262dc55b9a Author: Nikodemus Siivola Date: Fri Mar 30 17:55:55 2012 +0300 Revert "generic MEAN and MEDIAN, new function DISPLACE-ARRAY" This reverts commit 485544d4feb13d3f463f54a5605b3a480bc49046. MEAN and MEDIAN are again non-generic, and DISPLACE-ARRAY is removed. Motivation on the mailing list. ----------------------------------------------------------------------- Summary of changes: arrays.lisp | 11 ----------- numbers.lisp | 53 ++++++++--------------------------------------------- package.lisp | 1 - tests.lisp | 29 ----------------------------- 4 files changed, 8 insertions(+), 86 deletions(-) diff --git a/arrays.lisp b/arrays.lisp index 1f30150..76c1879 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -16,14 +16,3 @@ arguments." (setf (row-major-aref new-array i) (row-major-aref array i))) new-array)) - -(declaim (inline displace-array)) -(defun displace-array (array &key (offset 0) - (dimensions (- (array-total-size array) - offset))) - "Return an array displaced to ARRAY with the given OFFSET and DIMENSIONS. -Default arguments displace to a vector." - (make-array dimensions - :displaced-to array - :displaced-index-offset offset - :element-type (array-element-type array))) diff --git a/numbers.lisp b/numbers.lisp index 7340f26..03430cc 100644 --- a/numbers.lisp +++ b/numbers.lisp @@ -84,58 +84,21 @@ Examples: interpolation coefficient V." (+ a (* v (- b a)))) -(defgeneric mean (object) - (:documentation "Returns the mean of OBJECT. -Predefined methods work on sequences and arrays of numbers. Users can -define new methods.") - (:method ((object list)) - (let ((sum 0) - (count 0)) - (declare (fixnum count)) - (dolist (elt object) - (incf sum elt) - (incf count)) - (/ sum count))) - (:method ((object vector)) - ;; Need a separate method for vectors, since - ;; they could have fill-pointers which we need to respect. - (let ((n (length object))) - (/ (loop for index below n - summing (aref object index)) - n))) - (:method ((object array)) - (let ((n (array-total-size object))) - (/ (loop for index below n - summing (row-major-aref object index)) - n))) - (:method ((object sequence)) - ;; For implementations supporting custom sequence types. - (/ (reduce #'+ object) (length object)))) - -(defun median-in-place (vector) - (declare (vector vector)) - (let* ((vector (sort vector #'<)) +(declaim (inline mean)) +(defun mean (sample) + "Returns the mean of SAMPLE. SAMPLE must be a sequence of numbers." + (/ (reduce #'+ sample) (length sample))) + +(declaim (inline median)) +(defun median (sample) + "Returns median of SAMPLE. SAMPLE must be a sequence of real numbers." + (let* ((vector (sort (copy-sequence 'vector sample) #'<)) (length (length vector)) (middle (truncate length 2))) (if (oddp length) (aref vector middle) (/ (+ (aref vector middle) (aref vector (1- middle))) 2)))) -(defgeneric median (object) - (:documentation - "Returns median of OBJECT. -Predefined methods work on sequences and arrays of numbers. Users can -define new methods.") - (:method ((object list)) - (median-in-place (copy-sequence 'vector object))) - (:method ((object array)) - (median-in-place (copy-sequence 'vector (if (vectorp object) - object - (displace-array object))))) - (:method ((object sequence)) - ;; For implementations supporting custom sequence types. - (median-in-place (copy-sequence 'vector object)))) - (declaim (inline variance)) (defun variance (sample &key (biased t)) "Variance of SAMPLE. Returns the biased variance if BIASED is true (the default), diff --git a/package.lisp b/package.lisp index 8bdf060..673ed30 100644 --- a/package.lisp +++ b/package.lisp @@ -101,7 +101,6 @@ #:array-index #:array-length #:copy-array - #:displace-array ;; Sequences #:copy-sequence #:deletef diff --git a/tests.lisp b/tests.lisp index 7d7d1ca..bd2725f 100644 --- a/tests.lisp +++ b/tests.lisp @@ -47,24 +47,6 @@ (typep copy 'simple-array))) t) -(deftest displace-array.1 - (displace-array #2A((1 2) - (3 4))) - #(1 2 3 4)) - -(deftest displace-array.2 - (displace-array #2A((1 2) - (3 4)) - :offset 1) - #(2 3 4)) - -(deftest displace-array.3 - (displace-array #2A((1 2) - (3 4)) - :offset 1 - :dimensions '(3 1)) - #2A((2) (3) (4))) - (deftest array-index.1 (typep 0 'array-index) t) @@ -976,12 +958,6 @@ (mean '(1 2 10)) 13/3) -(deftest mean.4 - (mean #2A((1 2 3) - (4 5 6) - (7 8 9))) - 5) - (deftest median.1 (median '(100 0 99 1 98 2 97)) 97) @@ -990,11 +966,6 @@ (median '(100 0 99 1 98 2 97 96)) 193/2) -(deftest median.3 - (median #2A((100 0 99 1) - (98 2 97 96))) - 193/2) - (deftest variance.1 (variance (list 1 2 3)) 2/3) -- Alexandria hooks/post-receive From nsiivola at common-lisp.net Fri Mar 30 15:06:28 2012 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 30 Mar 2012 08:06:28 -0700 Subject: [alexandria.git] updated branch master: 209c6e2 clarify SHUFFLE docstring Message-ID: The branch master has been updated: via 209c6e29adf83292745092200279847daa99a18d (commit) from 4119ce8ae6baf661d426a09e44d07c262dc55b9a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 209c6e29adf83292745092200279847daa99a18d Author: Nikodemus Siivola Date: Fri Mar 30 18:05:35 2012 +0300 clarify SHUFFLE docstring It's destructive. ----------------------------------------------------------------------- Summary of changes: sequences.lisp | 5 +++-- 1 files changed, 3 insertions(+), 2 deletions(-) diff --git a/sequences.lisp b/sequences.lisp index e7f1925..9e4ff74 100644 --- a/sequences.lisp +++ b/sequences.lisp @@ -81,8 +81,9 @@ share structure with it." (defun shuffle (sequence &key (start 0) end) "Returns a random permutation of SEQUENCE bounded by START and END. -Permuted sequence may share storage with the original one. Signals an -error if SEQUENCE is not a proper sequence." +Original sequece may be destructively modified, and share storage with +the original one. Signals an error if SEQUENCE is not a proper +sequence." (declare (type fixnum start) (type (or fixnum null) end)) (etypecase sequence -- Alexandria hooks/post-receive From nsiivola at common-lisp.net Fri Mar 30 15:23:11 2012 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 30 Mar 2012 08:23:11 -0700 Subject: [alexandria.git] updated branch master: 4955542 copy-stream: fix non-standard loops Message-ID: The branch master has been updated: via 49555427d8019a56132def9a4440663c66339131 (commit) from 209c6e29adf83292745092200279847daa99a18d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 49555427d8019a56132def9a4440663c66339131 Author: Nikodemus Siivola Date: Fri Mar 30 18:22:47 2012 +0300 copy-stream: fix non-standard loops Added test-case. ----------------------------------------------------------------------- Summary of changes: io.lisp | 45 +++++++++++++++++++++------------------------ tests.lisp | 23 +++++++++++++++++++++++ 2 files changed, 44 insertions(+), 24 deletions(-) diff --git a/io.lisp b/io.lisp index ee89cb0..52551c7 100644 --- a/io.lisp +++ b/io.lisp @@ -122,31 +122,28 @@ compatible element-types." (input-position 0)) (unless (zerop start) ;; FIXME add platform specific optimization to skip seekable streams - (loop - :while (< input-position start) - :for bytes-read = (read-sequence buffer input - :end (min (length buffer) - (- start input-position))) - :do (progn - (when (zerop bytes-read) - (error "Could not read enough bytes from the input to fulfill the START requirement in ~S" 'copy-stream)) - (incf input-position bytes-read)))) + (loop while (< input-position start) + do (let ((n (read-sequence buffer input + :end (min (length buffer) + (- start input-position))))) + (when (zerop n) + (error "~@" 'copy-stream start)) + (incf input-position n)))) (assert (= input-position start)) - (loop - :while (or (null end) - (< input-position end)) - :for bytes-read = (read-sequence buffer input - :end (when end - (min (length buffer) - (- end input-position)))) - :do (progn - (when (zerop bytes-read) - (if end - (error "Could not read enough bytes from the input to fulfill the END requirement in ~S" 'copy-stream) - (return))) - (incf input-position bytes-read) - (write-sequence buffer output :end bytes-read) - (incf output-position bytes-read))) + (loop while (or (null end) (< input-position end)) + do (let ((n (read-sequence buffer input + :end (when end + (min (length buffer) + (- end input-position)))))) + (when (zerop n) + (if end + (error "~@" 'copy-stream end) + (return))) + (incf input-position n) + (write-sequence buffer output :end n) + (incf output-position n))) (when finish-output (finish-output output)) output-position)) diff --git a/tests.lisp b/tests.lisp index bd2725f..b875382 100644 --- a/tests.lisp +++ b/tests.lisp @@ -1807,3 +1807,26 @@ (deftest binomial-coefficient.1 (alexandria:binomial-coefficient 1239 139) 28794902202288970200771694600561826718847179309929858835480006683522184441358211423695124921058123706380656375919763349913245306834194782172712255592710204598527867804110129489943080460154) + +(deftest copy-stream.1 + (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sdlkjfhslkdfh sdklfjh")) + (values (equal data + (with-input-from-string (in data) + (with-output-to-string (out) + (alexandria:copy-stream in out)))) + (equal (subseq data 10 20) + (with-input-from-string (in data) + (with-output-to-string (out) + (alexandria:copy-stream in out :start 10 :end 20)))) + (equal (subseq data 10) + (with-input-from-string (in data) + (with-output-to-string (out) + (alexandria:copy-stream in out :start 10)))) + (equal (subseq data 0 20) + (with-input-from-string (in data) + (with-output-to-string (out) + (alexandria:copy-stream in out :end 20)))))) + t + t + t + t) -- Alexandria hooks/post-receive