From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Dmitry Bogatov Newsgroups: gmane.lisp.guile.user Subject: Uniq list in Guile Date: Sat, 26 Oct 2013 11:12:40 +0400 Organization: Church of Emacs Message-ID: <87d2mspkt3.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-Trace: ger.gmane.org 1382771816 19231 80.91.229.3 (26 Oct 2013 07:16:56 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 26 Oct 2013 07:16:56 +0000 (UTC) To: "guile-user" Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sat Oct 26 09:17:01 2013 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VZy7J-0007QG-B0 for guile-user@m.gmane.org; Sat, 26 Oct 2013 09:17:01 +0200 Original-Received: from localhost ([::1]:33737 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VZy7I-0003sh-Se for guile-user@m.gmane.org; Sat, 26 Oct 2013 03:17:00 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:44237) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VZy76-0003sS-8T for guile-user@gnu.org; Sat, 26 Oct 2013 03:16:52 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VZy71-0001dI-Rq for guile-user@gnu.org; Sat, 26 Oct 2013 03:16:48 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:42587) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VZy71-0001dA-NE for guile-user@gnu.org; Sat, 26 Oct 2013 03:16:43 -0400 Original-Received: from s15866876.onlinehome-server.info ([213.165.71.31]:60402 helo=localhost) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1VZy70-0003ZM-UJ for guile-user@gnu.org; Sat, 26 Oct 2013 03:16:43 -0400 User-agent: mu4e 0.9.9.5; emacs 24.3.1 X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::e X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:10856 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain Hello! Recently I faced neseserity to uniq list in Guile. Surprised, that I did not found ready solution, I decided to prepare it. By analogy with sorting functions in `sort.c` I prepared `uniq.c`(attached, but unfinished patch, lacking proper documentation). But after I became curious, how slower would be Scheme version with (set-cdr!). To my test (random list of small integers) it is about twice as slow. Is Guile Mainline interested in these routines, and if yes, does in your opinion doubling execution speed worth resorting to C hacking? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Uniq-Scheme-lists-in-C.patch Content-Transfer-Encoding: quoted-printable Content-Description: Implement `uniq` and `uniq!` in C. From=200e5331e20446ba3318fd6ab0aabbcc40a4b4a5ab Mon Sep 17 00:00:00 2001 From: Dmitry Bogatov Date: Tue, 22 Oct 2013 15:56:43 +0400 Subject: [PATCH] Uniq Scheme lists in C Signed-off-by: Dmitry Bogatov =2D-- doc/ref/api-utility.texi | 29 ++++++++++++++- libguile/Makefile.am | 4 +++ libguile/init.c | 2 ++ libguile/uniq.c | 93 ++++++++++++++++++++++++++++++++++++++++++++= ++++ libguile/uniq.h | 39 ++++++++++++++++++++ 5 files changed, 166 insertions(+), 1 deletion(-) create mode 100644 libguile/uniq.c create mode 100644 libguile/uniq.h diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi index 76c50b2..22ffb27 100644 =2D-- a/doc/ref/api-utility.texi +++ b/doc/ref/api-utility.texi @@ -18,6 +18,7 @@ applications, they are collected in a @dfn{utility} chapt= er. * Object Properties:: A modern interface to object properties. * Sorting:: Sort utility procedures. * Copying:: Copying deep structures. +* Uniqueing:: Uniqueing lists. * General Conversion:: Converting objects to strings. * Hooks:: User-customizable event lists. @end menu @@ -256,7 +257,7 @@ to @var{value}. @end deffn =20 =20 =2D@node Sorting +@node Sorting, Copying, Object Properties, Utility Functions @subsection Sorting =20 @c FIXME::martin: Review me! @@ -372,6 +373,32 @@ the range of the vector which gets sorted. The return= value is not specified. @end deffn =20 +@node Uniqueing + +@cindex uniqueing +@cindex uniqueing lists + +Another common operation is getting unique elements of +sequence. Following procedures perform action, analogous to +@code{uniq}(1) program --- delete adjanced equal elements. If you need +remove all duplicates, @var{sort} or @var{sort!} it before. Since this +operation change length of sequence, vectors are not supported. + +@c snarfed from uniq.c:40 +@deffn {Scheme Procedure} uniq! items eq +Uniquify the list @var{items}, by deleting equal adjanced +elements. @var{eq} is used for comparing the sequence +elements. The sorting is destructive, that means that +the input sequence is modified to produce the sorted result. + +@end deffn + +@c snarfed from uniq.c:72 +@deffn {Scheme Procedure} uniq items eq +Uniquify the list @var{items}, by deleting equal adjanced +elements. @var{eq} is used for comparing the sequence +elements. +@end deffn =20 @node Copying @subsection Copying Deep Structures diff --git a/libguile/Makefile.am b/libguile/Makefile.am index ce437e4..2928843 100644 =2D-- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -221,6 +221,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =3D \ version.c \ vm.c \ vports.c \ + uniq.c \ weak-set.c \ weak-table.c \ weak-vector.c @@ -319,6 +320,7 @@ DOT_X_FILES =3D \ vectors.x \ version.x \ vports.x \ + uniq.x \ weak-set.x \ weak-table.x \ weak-vector.x @@ -422,6 +424,7 @@ DOT_DOC_FILES =3D \ vectors.doc \ version.doc \ vports.doc \ + uniq.doc \ weak-set.doc \ weak-table.doc \ weak-vector.doc @@ -642,6 +645,7 @@ modinclude_HEADERS =3D \ vm-expand.h \ vm.h \ vports.h \ + uniq.h \ weak-set.h \ weak-table.h \ weak-vector.h diff --git a/libguile/init.c b/libguile/init.c index 6787483..51698c4 100644 =2D-- a/libguile/init.c +++ b/libguile/init.c @@ -111,6 +111,7 @@ #include "libguile/smob.h" #include "libguile/socket.h" #include "libguile/sort.h" +#include "libguile/uniq.h" #include "libguile/srcprop.h" #include "libguile/stackchk.h" #include "libguile/stacks.h" @@ -465,6 +466,7 @@ scm_i_init_guile (void *base) scm_init_socket (); #endif scm_init_sort (); + scm_init_uniq (); scm_init_srcprop (); /* requires smob_prehistory */ scm_init_stackchk (); =20 diff --git a/libguile/uniq.c b/libguile/uniq.c new file mode 100644 index 0000000..4cc2b86 =2D-- /dev/null +++ b/libguile/uniq.c @@ -0,0 +1,93 @@ +/* Copyright (C) 2013 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#ifdef HAVE_CONFIG_H +# include +#endif + +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/arrays.h" +#include "libguile/array-map.h" +#include "libguile/feature.h" +#include "libguile/vectors.h" +#include "libguile/async.h" +#include "libguile/dynwind.h" + +#include "libguile/uniq.h" + + +SCM_DEFINE (scm_uniq_x, "uniq!", 2, 0, 0, + (SCM items, SCM eq), + "Uniquify the list @var{items}, by deleting equal adjanced\n" + "elements. @var{eq} is used for comparing the sequence\n" + "elements. The sorting is destructive, that means that\n" + "the input sequence is modified to produce the sorted result.\n") +#define FUNC_NAME s_scm_uniq_x +{ + int len; + SCM it =3D items; + + if (SCM_NULL_OR_NIL_P (items)) + return items; + + SCM_VALIDATE_LIST_COPYLEN(1, items, len); + + while (!SCM_NULL_OR_NIL_P(SCM_CDR(it))) + { + SCM cur =3D SCM_CAR(it); + SCM next =3D SCM_CADR(it); + if (scm_is_true (scm_call_2 (eq, cur, next))) + { + SCM_SETCDR(it, SCM_CDDR(it)); + } + else + { + it =3D SCM_CDR(it); + } + } + return items; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_uniq, "uniq", 2, 0, 0, + (SCM items, SCM eq), + "Uniquify the list @var{items}, by deleting equal adjanced\n" + "elements. @var{eq} is used for comparing the sequence \n" + "elements.") +#define FUNC_NAME s_scm_uniq +{ + if (SCM_NULL_OR_NIL_P (items)) + return items; + + return scm_uniq_x(scm_list_copy(items), eq); +} +#undef FUNC_NAME + + +void +scm_init_uniq (void) +{ +#include "libguile/uniq.x" +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/uniq.h b/libguile/uniq.h new file mode 100644 index 0000000..6926d01 =2D-- /dev/null +++ b/libguile/uniq.h @@ -0,0 +1,39 @@ +/* classes: h_files */ + +#ifndef SCM_UNIQ_H +#define SCM_UNIQ_H + +/* Copyright (C) 2013 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + + + +#include "libguile/__scm.h" + + +SCM_API SCM scm_uniq_x(SCM items, SCM eq); +SCM_API SCM scm_uniq(SCM items, SCM eq); +SCM_INTERNAL void scm_init_uniq(void); + +#endif /* SCM_UNIQ_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ =2D-=20 Recipients list generated via git-blame. Tell me, if you object. --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=perfomance.scm Content-Description: Code for simple benchmarking (define* (random-list #:key (length 1000) (limit 8)) (let loop ((seed '()) (index 0)) (if (= length index) seed (loop (cons (random limit) seed) (1+ index))))) (define nl (random-list #:length 10000)) (define sl (random-list #:length 10000)) (define (scm-uniq! lst eq) (let loop ((it lst)) (when (pair? (cdr it)) (if (eq (car it) (cadr it)) (begin (set-cdr! it (cddr it)) (loop it)) (loop (cdr it))))) lst) --=-=-= Content-Type: text/plain -- Best regards, Dmitry Bogatov , Free Software supporter and netiquette guardian. git clone git://kaction.name/rc-files.git --depth 1 GPG: 54B7F00D Html mail and proprietary format attachments are forwarded to /dev/null. --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v2.0.22 (GNU/Linux) iQIcBAEBAgAGBQJSa2ttAAoJEHiL4BJUt/ANoBYQAIcBeCkYbHT8aApgsdsDDqvN BanxTpLLFIWWSwJ9TtSK0/Hijg2C5z1qnmYhz5lI48kj5IC7Z8WB2MbmXmdMr81q kNn+niD0CSKGV7Tmbd13FvXm6hp6sgLfGMCAOzgw8dnswRbgMkXJKIq6MxYTCu5g ZUQ3S4G18gFVFCmpGKUqYPYzRCreTKOejh3bN6gdp4bBA+/XyUH4fj2++OFAy80l fdDZ0DbR/8q48S1vr6vhFG8OVJZpMBu5uJumVTYe0W+8ZBaB7NVZj7j7UlUyUkb5 voUU7zbbKB7NY52SpfwJRinSc3Vd1rHz7Sn3Q+x68SzVAuOIdmGYhe5XTSEkzypg MsHcXdIxVrNHsHTlFEcldMyrCcSJoJYYG8bbCIa/E6BzBH9H8GIod2/+Jr0dKpHP +8HWxwIr4Z36hNyxvaZkTMbQWvWUBnf7QYsAo2Gx2aEZ5kYlNMyhTZE6XvygsNkX d/mTJRvs5hVUzZwRQBoXHO8yTJdv+JUhKITf2BF6Er4lZpDjPJZxu+zpTBZvJr1M narl0R8nCNGWx/2OcPhq7RiGoo2UTL2YbsY2QkJohOdXoSHsUjQH/VLAIOzfmT6s AtTrFmePJCHDGHm5OCv5lkbznAMmdAvE8Y3Yqyf4LHa2bvr9s1spxCx2KTIbWSEV ZjbaTxvtz/e8JjGuUPCa =e+Ef -----END PGP SIGNATURE----- --==-=-=--