How can i write this function simply? (in Common Lisp)

-- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.

-- So the value is a list of 4 strings:
('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')

-- The order is not important.
If the string has 3 dots, the value is a list of length 8.

If the program is going to be simpler,
pls use, e.g. (a $ b c $) rather than 'a.bc.'

On 2024-05-18, HenHanna <HenHanna@devnull.tb> wrote:
> If the program is going to be simpler,
> pls use, e.g. (a $ b c $) rather than 'a.bc.'

Yes, the program can almost always be made simpler if you're free to
redefine the details of problem to suit your programming language.

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

On 2024-05-18, HenHanna <HenHanna@devnull.tb> wrote:
>
> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.
>
> If the program is going to be simpler,
> pls use, e.g. (a $ b c $) rather than 'a.bc.'

TXR Lisp:

(defun bindots (str)
(let* ((s (copy str))
(ixs (where (op eql #\.) s))
(n (len ixs)))
(collect-each ((digs (rperm '(#\0 #\1) n)))
(set [s ixs] digs)
(copy s))))

1> (bindots "abc")
("abc")
2> (bindots "a.bc")
("a0bc" "a1bc")
3> (bindots "a.b.c")
("a0b0c" "a0b1c" "a1b0c" "a1b1c")
4> (bindots "a.b.cd.e")
("a0b0cd0e" "a0b0cd1e" "a0b1cd0e" "a0b1cd1e" "a1b0cd0e" "a1b0cd1e"
"a1b1cd0e" "a1b1cd1e")

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

* HenHanna <v29p14$2mr5l$2@dont-email.me> :
Wrote on Sat, 18 May 2024 01:31:32 -0700:

> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')

(defun adjusted-logbitp (pos num total-width)
(let* ((int-len (integer-length num))
(i (- pos (- total-width int-len))))
(if (< i 0)
nil
(logbitp i num))))

(defun bindots (str)
(let* ((indices (loop for c across str for i from 0
if (eql c #\.) collect i))
(width (length indices)))
(loop for i below (expt 2 width)
collect (let ((ret (copy-seq str)))
(loop for j in indices
do (setf (aref ret j)
(if (adjusted-logbitp j i width)
#\1
#\0)))
ret))))

HenHanna <HenHanna@devnull.tb> writes:

> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.
>
> If the program is going to be simpler,
> pls use, e.g. (a $ b c $) rather than 'a.bc.'

; SLIME 2.26.1
CL-USER> (defun replace-dots (str)
(declare (string str))
(substitute #\1 #\. str))
REPLACE-DOTS
CL-USER> (replace-dots "this.a.bd.")
"this1a1bd1"
CL-USER>

Madhu <enometh@meer.net> writes:

> * HenHanna <v29p14$2mr5l$2@dont-email.me> :
> Wrote on Sat, 18 May 2024 01:31:32 -0700:
>
< > How can i write this function simply? (in Common Lisp)
< >
< > -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
< >
< > -- So the value is a list of 4 strings:
< > ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> (defun adjusted-logbitp (pos num total-width)
> (let* ((int-len (integer-length num))
> (i (- pos (- total-width int-len))))
> (if (< i 0)
> nil
> (logbitp i num))))
>
> (defun bindots (str)
> (let* ((indices (loop for c across str for i from 0
> if (eql c #\.) collect i))
> (width (length indices)))
> (loop for i below (expt 2 width)
> collect (let ((ret (copy-seq str)))
> (loop for j in indices
> do (setf (aref ret j)
> (if (adjusted-logbitp j i width)
> #\1
> #\0)))
> ret))))

what about substitute? common lisp is not scheme of the week.

Kaz Kylheku <643-408-1753@kylheku.com> writes:

> On 2024-05-18, HenHanna <HenHanna@devnull.tb> wrote:
< >
< > How can i write this function simply? (in Common Lisp)
< >
< > -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
< >
< > -- So the value is a list of 4 strings:
< > ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
< >
< > -- The order is not important.
< > If the string has 3 dots, the value is a list of length 8.
< >
< > If the program is going to be simpler,
< > pls use, e.g. (a $ b c $) rather than 'a.bc.'
>
> TXR Lisp:
>
> (defun bindots (str)
> (let* ((s (copy str))
> (ixs (where (op eql #\.) s))
> (n (len ixs)))
> (collect-each ((digs (rperm '(#\0 #\1) n)))
> (set [s ixs] digs)
> (copy s))))

where is collect-each in common lisp?
set [x] is no good! not in lisp

* steve <87frueibe0.fsf@gmail.com> :
Wrote on Sun, 19 May 2024 02:06:15 -0400:
>> (defun bindots (str)
>> (let* ((indices (loop for c across str for i from 0
>> if (eql c #\.) collect i))
>> (width (length indices)))
>> (loop for i below (expt 2 width)
>> collect (let ((ret (copy-seq str)))
>> (loop for j in indices
>> do (setf (aref ret j)
>> (if (adjusted-logbitp j i width)
>> #\1
>> #\0)))
>> ret))))
>
> what about substitute? common lisp is not scheme of the week.

Substitute doesn't help here, you want to mutate specific locations in
each string to produce a "combinatorial" result.

HenHanna <HenHanna@devnull.tb> writes:

> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.
>
> If the program is going to be simpler,
> pls use, e.g. (a $ b c $) rather than 'a.bc.'

Another one:

(defun subst-dots (s &optional (pos 0))
(let ((p (search "." s :start2 pos)))
(if p
(append
(subst-dots (replace (copy-seq s) "0" :start1 p) (1+ p))
(subst-dots (replace (copy-seq s) "1" :start1 p) (1+ p)))
(list s))))

Regards

On 2024-05-18, Kaz Kylheku <643-408-1753@kylheku.com> wrote:
> On 2024-05-18, HenHanna <HenHanna@devnull.tb> wrote:
>>
>> How can i write this function simply? (in Common Lisp)
>>
>> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>>
>> -- So the value is a list of 4 strings:
>> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>>
>> -- The order is not important.
>> If the string has 3 dots, the value is a list of length 8.
>>
>> If the program is going to be simpler,
>> pls use, e.g. (a $ b c $) rather than 'a.bc.'
>
> TXR Lisp:
>
> (defun bindots (str)
> (let* ((s (copy str))
> (ixs (where (op eql #\.) s))
> (n (len ixs)))
> (collect-each ((digs (rperm '(#\0 #\1) n)))
> (set [s ixs] digs)
> (copy s))))

Using format. I.e. transform an input string like "a.b~c.d.e" into
the format string "a~ab~~c~ad~ae", and then feed it the digit
permutations as arguments, which can now be integers:

(defun bindots (str)
(let* ((n (countql #\. str))
(fs (flow str
(regsub "~" "~~")
(regsub "." "~a"))))
(collect-each ((digs (rperm '(0 1) n)))
(fmt fs . digs))))

Doh, why stick to the collect-each copy paste; it's a mapcar job:

(defun bindots (str)
(let* ((n (countql #\. str))
(fs (flow str
(regsub "~" "~~")
(regsub "." "~a"))))
(mapcar (ap fmt fs) (rperm '(0 1) n))))

Use flow syntax for the whole body:

(defun bindots (str)
(flow str
(regsub "~" "~~")
(regsub "." "~a")
(mapcar (ap fmt @@1) (rperm '(0 1) (countql #\. str)))))

Why @@1? (ap fmt @1) would refer to the ap expression's own parameter 1. @@1
escapes one level out to access the (mapcar ...) expression's implicit
parameter 1, which is the prepared format string coming out of the previous
regsub.

The op syntax, inspired the op operator in MIT Goo, has a fully
developed argument referencing system that supports nesting,
reminiscent of nested commas in backquotes.

Whenver an op expression explicitly refers to parameter material
using @1, @2, ... or @rest, this has the effect of suppressing
the insertion of the implicit rightmost parameter @1, the idea
being that the expression is taking full control over what arguments are
inserted where.

Thus because @@1 mentions an implicit parameter of the mapcar
expression, that expression no longer receives an implicit rightmost
argument. We want this, because otherwise the format string object
from the previous regsub pipeline element would appear as an extra
sequence for mapcar to traverse.

Instead of rperm, we could also count up to below (expt 2 n),
and then use digits to explode digits, like this.
Ah, right but no, because we don't get leading zeros. I will
still mention this:

1> (mapcar (lop digits 2) 0..16)
((0) (1) (1 0) (1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1) (1 0 0 0)
(1 0 0 1) (1 0 1 0) (1 0 1 1) (1 1 0 0) (1 1 0 1) (1 1 1 0) (1 1 1 1))

In TXR, I have moved toward generic iteration. Most of the library
is converted.

Actually since now ancient history, sequences other than list have been
traversable with car and cdr, and still are. But that convenience is
inefficient due to copying.

There is an iteration system which works like this:

1> (iter-begin '(a b c))
(a b c)
2> (iter-more *1)
t 3> (iter-item *1)
a 4> (iter-step *1)
(b c)
5> (iter-begin "abc")
#<seq-iter: 85d75f0>
6> (iter-more *5)
t 7> (iter-item *5)
#\a
8> (iter-step *5)
#<seq-iter: 85d75f0>
9> (iter-item *5)
#\b

Iterators can be functional or stateful, so the return value of iter-step must
be captured.

Above, (iter-begin "abc") produces a heap object, whereas (iter-begin '(a b c))
just returns (a b c).

mapcar efficiently allocates the iterator objects on the stack. In that case,
list iteration uses an iterator object also; it's not just using the list
as an iterator.

The public function iter-begin performs this optimization whereby for certain
objects, an iteration object need not be constructed, because iter-more,
iter-item and iter-step can handle the original representation.

E.g. infinitely iterate from 3:

1> (iter-begin 3) ;; identity
3 2> (iter-more *1) ;; unconditional true
t 3> (iter-item *1) ;; identity
3 4> (iter-step *1) ;; successor function
4

Since numbers are iterable, we can easily add numbering in
a mapcar, just by mentioning a number as one of the sequence
arguments.

1> (mapcar (do pic `>>:0#` @1 @2) "AA".."DD" 0)
("AA:00" "AB:01" "AC:02" "AD:03" "BA:04" "BB:05" "BC:06" "BD:07"
"CA:08" "CB:09" "CC:10" "CD:11" "DA:12" "DB:13" "DC:14" "DD:15")

do is the variant of op which handles macros rather than functions.

The pipelining opip (basis of flow macro) automatically applies do or
op to the pipeline elements based on whether they have an operator
or function binding. Thus we can do

(flow whatever (mapcar ...) (if ...) (progn ..))

The mapcar will be treated as an (op mapcar ...) the if and progn
as (do if ...) and (do progn ...).

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

On 5/19/2024 11:36 AM, Joerg Mertens wrote:
> HenHanna <HenHanna@devnull.tb> writes:
>
>> How can i write this function simply? (in Common Lisp)
>>
>> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>>
>> -- So the value is a list of 4 strings:
>> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>>
>> -- The order is not important.
>> If the string has 3 dots, the value is a list of length 8.
>>
>> If the program is going to be simpler,
>> pls use, e.g. (a $ b c $) rather than 'a.bc.'

>
> Another one:
>
> (defun subst-dots (s &optional (pos 0))
> (let ((p (search "." s :start2 pos)))
> (if p
> (append
> (subst-dots (replace (copy-seq s) "0" :start1 p) (1+ p))
> (subst-dots (replace (copy-seq s) "1" :start1 p) (1+ p)))
> (list s))))
>
> Regards

Nice... Thanks !

* HenHanna <v2irh1$ndjr$2@dont-email.me> :
Wrote on Tue, 21 May 2024 12:09:22 -0700:
> On 5/19/2024 11:36 AM, Joerg Mertens wrote:
>> HenHanna <HenHanna@devnull.tb> writes:
>>
>>> How can i write this function simply? (in Common Lisp)
>>>
>>> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>>>
>>> -- So the value is a list of 4 strings:
>>> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>>>
>>> -- The order is not important.
>>> If the string has 3 dots, the value is a list of length 8.
>>>
>>> If the program is going to be simpler,
>>> pls use, e.g. (a $ b c $) rather than 'a.bc.'
>
>
>> Another one:
>> (defun subst-dots (s &optional (pos 0))
>> (let ((p (search "." s :start2 pos)))
>> (if p
>> (append
>> (subst-dots (replace (copy-seq s) "0" :start1 p) (1+ p))
>> (subst-dots (replace (copy-seq s) "1" :start1 p) (1+ p)))
>> (list s))))
>> Regards
> Nice... Thanks

so my response to Steve in <m3bk52kmfu.fsf@leonis4.robolove.meer.net> :
on [Sun, 19 May 2024 18:06:53 +0530] where I said "Substitute doesn't
help here" was wrong. You can use SUBSTITUTE here like this

(defun subst-dots (s &optional (pos 0))
(let ((p (search "." s :start2 pos)))
(if p
(append
(subst-dots (substitute #\0 #\. s :start p :count 1) (1+ p))
(subst-dots (substitute #\1 #\. s :start p :count 1) (1+ p)))
(list s))))

[Apparently my machine crashed shortly after I sent that message and zfs
didn't help preserve it - I don't have a copy of it under
Mail/archive/sent ]

On 5/18/2024, HenHanna wrote:

>
> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.
>
> If the program is going to be simpler,
> pls use, e.g. (a $ b c $) rather than 'a.bc.'

Gauche Scheme:

(define (dotty s)
(define (f r) (dotty (regexp-replace "[.]" s r)))
(if (string-scan s #\.)
(apply append (map f '("0" "1")))
(list s)))

gosh> (dotty "a.b.c")
("a0b0c" "a0b1c" "a1b0c" "a1b1c")

HenHanna <HenHanna@devnull.tb> writes:

> How can i write this function simply? (in Common Lisp)
>
> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.

Oh, all right. I'll bite.

(defun replace-dots (string &key (start 0) end)
(unless end (setf end (length string)))
(let ((dots (make-array 16
:element-type 'fixnum
:adjustable t
:fill-pointer 0))
(string (copy-seq string)))

(do ((pos (position #\. string :start start :end end)
(position #\. string :start (1+ pos) :end end)))
((null pos))
(vector-push-extend pos dots))

(let* ((ndots (length dots))
(niter (ash 1 ndots))
(list nil))
(dotimes (i ndots)
(setf (char string (aref dots i)) #\0))
(push (copy-seq string) list)
(do ((i 1 (1+ i)))
((>= i niter))
(let* ((k (1- (integer-length (logand i (- i)))))
(dot (aref dots k)))
(setf (char string dot)
(code-char (logxor (char-code (char string dot))
#.(logxor (char-code #\0)
(char-code #\1)))))
(push (copy-seq string) list)))

list)))

Now that I look again, I see that you asked for `simple'. I fail at
that. But it's nonrecursive, and, perhaps, an interesting approach.

-- [mdw]

On 5/24/2024 5:54 AM, WJ wrote:
> On 5/18/2024, HenHanna wrote:
>
>>
>> How can i write this function simply? (in Common Lisp)
>>
>> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>>
>> -- So the value is a list of 4 strings:
>> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>>
>> -- The order is not important.
>> If the string has 3 dots, the value is a list of length 8.
>>
>> If the program is going to be simpler,
>> pls use, e.g. (a $ b c $) rather than 'a.bc.'
>
> Gauche Scheme:
>
> (define (dotty s)
> (define (f r) (dotty (regexp-replace "[.]" s r)))
> (if (string-scan s #\.)
> (apply append (map f '("0" "1")))
> (list s)))
>
>
> gosh> (dotty "a.b.c")
> ("a0b0c" "a0b1c" "a1b0c" "a1b1c")
>
>

nice... The description "a Lisp Haiku" seems appropriate
(since i don't fully get how it works)

i've not seen that style before... what else would you write in that
style? Permutation? Combination? Cartesian-Power?

here's a slight rewrite. I'd never used map! before today.

(use scheme.list)
(define (dotty x)
(if (string-scan x #\.)
(map! (lambda (d) (dotty (regexp-replace "[.]" x d)))
(list "0" "1"))
(list x)))

oh..Ok..i still need to do Apply-Append
because map! is NOT (at all like) Mapcan

On 5/18/2024, HenHanna wrote:

> -- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
>
> -- So the value is a list of 4 strings:
> ('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
>
> -- The order is not important.
> If the string has 3 dots, the value is a list of length 8.

Gauche Scheme:

(use srfi-13) ;; string-count
(use util.combinations) ;; cartesian-product

(define (dot s)
(let ((b (cartesian-product (make-list (string-count s #\.) '(0 1))))
(fs (regexp-replace-all "[.]" s "~d")))
(map (cut apply format fs <>) b)))

(dot "a.b.c")
===>
("a0b0c" "a0b1c" "a1b0c" "a1b1c")

(dot "a.b")
===>
("a0b" "a1b")

(dot "ab.")
===>
("ab0" "ab1")

(dot ".ab")
===>
("0ab" "1ab")

(dot "ab")
===>
("ab")

* "WJ" <v2q2mg$2b3ru$1@dont-email.me> :
Wrote on Fri, 24 May 2024 12:54:41 -0000 (UTC):

welcome back!

Madhu <enometh@meer.net> writes:

> Substitute doesn't help here, you want to mutate specific locations in
> each string to produce a "combinatorial" result.

how about Nsubstitute?

Madhu <enometh@meer.net> writes:

> so my response to Steve in <m3bk52kmfu.fsf@leonis4.robolove.meer.net> :
> on [Sun, 19 May 2024 18:06:53 +0530] where I said "Substitute doesn't
> help here" was wrong. You can use SUBSTITUTE here like this
>
> (defun subst-dots (s &optional (pos 0))
> (let ((p (search "." s :start2 pos)))
> (if p
> (append
> (subst-dots (substitute #\0 #\. s :start p :count 1) (1+ p))
> (subst-dots (substitute #\1 #\. s :start p :count 1) (1+ p)))
> (list s))))
>
>
> [Apparently my machine crashed shortly after I sent that message and zfs
> didn't help preserve it - I don't have a copy of it under
> Mail/archive/sent ]

there is also mismatch and Nsubstitute. not very scheme-like but...

Here is some emacs lisp for common lisp..

(defun mapnconcat (fn sequences seperator)
"Like MAPCONCAT but the function is desctuctive."
(let ((seperator-length 0)
(total 0) (times -1) result)
(declare (fixnum seperator-length total times))
(unless (eq fn #'identity)
(map-into sequences fn sequences))
(setq seperator-length (the fixnum (length seperator)))
(dolist (seq sequences)
(incf times) (incf total (+ (length seq) seperator-length)))
(setq result (make-string (- total seperator-length)))
(let ((pos -1)) (declare (fixnum pos))
(loop repeat times do
(let ((seq (pop sequences)))
(loop for i across seq do
(setf (schar result (incf pos)) i))
(loop for i across seperator do
(setf (aref result (incf pos)) i))))
(loop for i across (car sequences) do
(setf (schar result (incf pos)) i)))
result))

(defun mapconcat (fn sequences seperator)
"Applies <FN> to each element of <SEQUENCES>; the results, which
must be sequences of characters (strings, vectors, or lists), are
concatenated into a single string return value. Between each pair of
result sequences, <mapconcat> inserts the characters from <SEPARATOR>,
which also must be a string, or a vector or list of characters."
(if (eq fn #'identity)
(mapnconcat fn sequences seperator)
(let ((result ""))
(dolist (seq (cdr sequences))
(setq result
(concatenate 'string
result seperator (funcall fn seq))))
(concatenate 'string (funcall fn (car sequences)) result))))

CL-USER>
; No value
CL-USER>
; No value
CL-USER> (mapconcat #'identity '("1234" "ff.ff" "255255") ".!")
"1234.!ff.ff.!255255"
CL-USER> (defun dot-to-ex (ch)
(if (eql ch #\.) #\_ ch))

DOT-TO-EX
;; this is no good for you

CL-USER> (mapconcat #'dot-to-ex '("1234" "ff.ff" "255255") ".!")
"1234.!ff.ff.!255255"
CL-USER> (mapconcat #'dot-to-ex '("1234" "ff.ff" "255255") ".")
"1234.ff.ff.255255"
CL-USER> (mapconcat #'dot-to-ex '("1234" "ff.ff" "255.255") ".")
"1234.ff.ff.255.255"

CL-USER> (defun dot-to-ex (ch)
(substitute #\_ #\. ch))

DOT-TO-EX
CL-USER> (mapconcat #'dot-to-ex '("1234" "ff.ff" "255.255") ".")
"1234.ff_ff.255_255"
CL-USER>

Have fun

On Tue, 28 May 2024 21:06:31 -0400, steve wrote:

> (defun mapnconcat (fn sequences seperator)
> "Like MAPCONCAT but the function is desctuctive."
> (let ((seperator-length 0)
> (total 0) (times -1) result)
> (declare (fixnum seperator-length total times))
> (unless (eq fn #'identity)
> (map-into sequences fn sequences))
> (setq seperator-length (the fixnum (length seperator)))
> (dolist (seq sequences)
> (incf times) (incf total (+ (length seq) seperator-length)))
> (setq result (make-string (- total seperator-length)))
> (let ((pos -1)) (declare (fixnum pos))
> (loop repeat times do
> (let ((seq (pop sequences)))
> (loop for i across seq do
> (setf (schar result (incf pos)) i))
> (loop for i across seperator do
> (setf (aref result (incf pos)) i))))
> (loop for i across (car sequences) do
> (setf (schar result (incf pos)) i)))
> result))

How about:

(defun mapnconcat (fn sequences separator)
"Like MAPCONCAT but the function is destructive."
(let
(
(separator-length 0)
(total 0)
(times -1)
result
)
(declare (fixnum separator-length total times))
(unless (eq fn #'identity)
(map-into sequences fn sequences)
) ; unless
(setq separator-length (the fixnum (length separator)))
(dolist (seq sequences)
(incf times)
(incf total (+ (length seq) separator-length))
) ; dolist
(setq result (make-string (- total separator-length)))
(let ((pos -1))
(declare (fixnum pos))
(loop repeat times do
(let ((seq (pop sequences)))
(loop for i across seq do
(setf (schar result (incf pos)) i)
) ; loop
(loop for i across separator do
(setf (aref result (incf pos)) i)
) ; loop
) ; let
) ; loop
(loop for i across (car sequences) do
(setf (schar result (incf pos)) i)
) ; loop
) ; let
result
) ; let
) ; mapconcat

* Lawrence D'Oliveiro <v362ae$v652$2@dont-email.me> :
Wrote on Wed, 29 May 2024 02:01:50 -0000 (UTC):
> On Tue, 28 May 2024 21:06:31 -0400, steve wrote:
>
>> (defun mapnconcat (fn sequences seperator)
>> "Like MAPCONCAT but the function is desctuctive."
>> (let ((seperator-length 0)
>> (total 0) (times -1) result)
>> (declare (fixnum seperator-length total times))
>> (unless (eq fn #'identity)
>> (map-into sequences fn sequences))
>> (setq seperator-length (the fixnum (length seperator)))
>> (dolist (seq sequences)
>> (incf times) (incf total (+ (length seq) seperator-length)))
>> (setq result (make-string (- total seperator-length)))
>> (let ((pos -1)) (declare (fixnum pos))
>> (loop repeat times do
>> (let ((seq (pop sequences)))
>> (loop for i across seq do
>> (setf (schar result (incf pos)) i))
>> (loop for i across seperator do
>> (setf (aref result (incf pos)) i))))
>> (loop for i across (car sequences) do
>> (setf (schar result (incf pos)) i)))
>> result))
>
> How about:
> (defun mapnconcat (fn sequences separator)
> "Like MAPCONCAT but the function is destructive."
> (let
> (
> (separator-length 0)
> (total 0)
> (times -1)
> result
> )
> (declare (fixnum separator-length total times))
> (unless (eq fn #'identity)
> (map-into sequences fn sequences)
> ) ; unless
> (setq separator-length (the fixnum (length separator)))
> (dolist (seq sequences)
> (incf times)
> (incf total (+ (length seq) separator-length))
> ) ; dolist
> (setq result (make-string (- total separator-length)))
> (let ((pos -1))
> (declare (fixnum pos))
> (loop repeat times do
> (let ((seq (pop sequences)))
> (loop for i across seq do
> (setf (schar result (incf pos)) i)
> ) ; loop
> (loop for i across separator do
> (setf (aref result (incf pos)) i)
> ) ; loop
> ) ; let
> ) ; loop
> (loop for i across (car sequences) do
> (setf (schar result (incf pos)) i)
> ) ; loop
> ) ; let
> result
> ) ; let
> ) ; mapconcat

from my ~/.cmucl-init this is how i expect mapconcat to look in CL

(defun map-concatenate (result-type function sequence separator &key (start 0)
end from-end)
(reduce (lambda (&rest rest)
(when rest
(destructuring-bind (a b) rest
(concatenate result-type a separator b))))
sequence :key function :start start :end end :from-end
from-end))

Madhu <enometh@meer.net> writes:

> from my ~/.cmucl-init this is how i expect mapconcat to look in CL
>
> (defun map-concatenate (result-type function sequence separator &key (start 0)
> end from-end)
> (reduce (lambda (&rest rest)
> (when rest
> (destructuring-bind (a b) rest
> (concatenate result-type a separator b))))
> sequence :key function :start start :end end :from-end
> from-end))

yes, this is much easier. I just went with emacs and left nmapconcat and
mapconcat...

the use of other keys is worth the effort but I needed something simple.