Discussion:
X in every language syndrome
(too old to reply)
Axel Reichert
2020-05-13 20:10:29 UTC
Hello,

my programming language background is mostly an imperative one, even if
for more than a decade now augmented by Python. Maybe two years back I
came across functional programming and was immediately hooked by the
concepts. As an old .emacs tinkerer I gave the "real" Lisp a try.

Yesterday I heard about a nice math question for talented kids and
thought this to be a nice exercise to try my Common Lisp skills (I know
how to tackle the problem from a pure mathematical point of view, so
this is not the point here). The question is about so-called "bellied"
numbers, defined as 4-digit integers for which the sum of the two
"middle" digits is smaller than the sum of the two outer digits. So 1265
is bellied, while 4247 is not.

This checking part is easy:

(defun bellied-number-p (n)
(> (+ (mod (truncate n 10) 10) (mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000))))

Now the task is to find the longest, uninterrupted sequence of bellied
numbers within all 4-digit number, hence from 1000 to 9999. And this is
where I terribly screwed up:

While the following code does the job,

(let ((max-length 0)
(current-length 0)
(last-bellied-number 0))
(dotimes (m 9000)
(let ((n (+ 1000 m)))
(if (bellied-number-p n)
(incf current-length)
(progn
(when (> current-length max-length)
(setf max-length current-length)
(setf last-bellied-number (1- n)))
(setf current-length 0)))))
(print (format t "~&Longest sequence of ~a bellied numbers ends at ~a."
max-length last-bellied-number)))

when I looked at this monster, I thought "Fortran in every language
syndrome". So I had to try harder to get something without loops, without
side effects except for the final print, without global state, hopefully
something nice with mapcar et. al. and tail-recursion. (-:

I found it terribly difficult to wrap my head around these concepts, as
brilliant as I think them to be from a theoretical point of view. Deeply
ingrained habits are no so easy to get rid of, it seemed ...

It got worse, my next try applied some higher order function in
composition, but got the wrong result and was a real "Frankencode":

(defun bellied-number-p (n)
(if
(> (+ (mod (truncate n 10) 10) (mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000)))
1 0))

(let ((candidates (alexandria:iota 1000 :start 1000)))
(apply #'max
(mapcar #'length
(ppcre:all-matches-as-strings
"1+"
(substitute #\linefeed #\0
(remove #\SPACE
(format nil "~a"
(mapcar #'bellied-number-p
candidates))))))))

This one is "Shell scripting in every language syndrome", compare with:

seq 1000 9999 | sed 's/\(.\)/\1 /g' | \
awk '{if (\$2 + \$3 > \$1 + \$4) {print 1} else {print "0"}}' | \
tr -d '\n' | tr -s "0" "\n" | sort | tail -n 1 | tr -d '\n' | wc -c

This is a neat and simple one-liner which took me 5 minutes to cobble
together instead of 5 hours ...

Of course it is a misuse to convert a list into a string that is then
tortured to extract the (originally numerical) information hidden in it,
etc. etc.

Two questions, though, may be allowed on this:

1. I am quite sure that the wrong result is due to the pretty printing
of the Lisp output, such that line wrapping occurs and the regex fails
to count the subsequent 1s correctly. How could I (in general, not for
this problem) increase the line width for "formatted" output by the Lisp
printer?

2. Calling one list-manipulating function after the other seems to be an
elegant concept (probably because it reminds me on pipes in shell
programming). However, I have no idea how one could avoid the above
indentation nightmare. How to deal with and un-clutter this excessive
chaining?

Finally, after another one or two hours of frustration, I got
enlightened (or so it seemed to me by comparison) and came up with this:

(defun bellied-checker (start end)
(labels ((bellied-checker-helper (n n-max this-length max-length)
(if (<= n n-max)
(if (> (+ (mod (truncate n 10) 10)
(mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000)))
(bellied-checker-helper (1+ n) n-max
(1+ this-length) max-length)
(bellied-checker-helper (1+ n) n-max 0
(max this-length max-length)))
(print max-length)))))
(bellied-checker-helper start end 0 0))

No global state, nested function definitions, no loops, recursion (is it
tail-recursive? I think so).

From an experienced Lisper's point of view: How can this be improved
(indentation, modularization, ...)?

If you have read this far, am I already thankful and would be even more
so for each and every criticism!

Best regards

Axel (who fortunately for himself and the rest of world is not a professional
programmer)
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Kaz Kylheku
2020-05-14 02:16:42 UTC
Post by Axel Reichert
Hello,
my programming language background is mostly an imperative one, even if
for more than a decade now augmented by Python. Maybe two years back I
came across functional programming and was immediately hooked by the
concepts. As an old .emacs tinkerer I gave the "real" Lisp a try.
Yesterday I heard about a nice math question for talented kids and
thought this to be a nice exercise to try my Common Lisp skills (I know
how to tackle the problem from a pure mathematical point of view, so
this is not the point here). The question is about so-called "bellied"
numbers, defined as 4-digit integers for which the sum of the two
"middle" digits is smaller than the sum of the two outer digits. So 1265
is bellied, while 4247 is not.
But the sum of the two middle digits of 1265 is greater than
the sum of the outer digits.

I suspect you misstated the requirement here; the number has a belly in
the middle (is "bellied") if the inner sum is fatter than the outer
sum.
Post by Axel Reichert
(defun bellied-number-p (n)
(> (+ (mod (truncate n 10) 10) (mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000))))
Now the task is to find the longest, uninterrupted sequence of bellied
numbers within all 4-digit number, hence from 1000 to 9999. And this is
TXR Lisp.

Having defined:

(defun bellied-p (num)
(let ((d (digits num)))
(and (= 4 (len d))
(< (+ [d 0] [d 3])
(+ [d 1] [d 2])))))

We casually do this at the prompt:

1> [find-max [partition-by bellied-p (range 1000 9999)] :
[iff [chain car bellied-p] len (ret 0)]]
(1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932
1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945
1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958
1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971
1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984
1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997
1998 1999)

Don't mind the square brackets; all they do is give us Lisp-1-style
evaluation, so we can refer to function names as values without
needing #' or (function ...) and call functions without (funcall ...).
Yet without throwing away the baby with the bathwater, and staying
in a nice Lisp-2.

TXR Lisp has a built in digits function for exploding an integer
into digits (decimal by default, but other bases are supported):

2> (digits 31 2)
(1 1 1 1 1)

(range 1000 9999) gives us a list from 1000 to 9999. (It'a a lazy list, but here
that matters little, since we force all of it to exist).

partition-by breaks a sequence into partitions, returning list
of them, according to a given equivalence function. Here, we use
bellied-p as that function. Thus the list is divided into partitions that
are runs of bellied-p numbers and non-bellied-p numbers.

find-max finds the maximum element of a sequence. We want the maximum-length
partition, but only among those partitions which are bellied numbers.
So for the key function we use:

[iff [chain car bellied-p] len (ret 0)]

iff is functional if: it's an "if" which combines functions and returns
a function. The function we have produced takes its argument and passes
it to the [chain car bellied-p] function: a function that takes the
care of the argument, and then tests it with bellied-p.

If this yields true, then iff passes its argument to len: we take
the length of that partition.

If it yields false, then iff passes its argument to the (ret 0)
function which ignores that argument and returns zero: i.e. we pretend
that any length sequence of non-bellied integers has length zero,
so find-max will not declare it to longer than any bellied
sequence.

Closing remarks: funny how the bellied integers (assuming I got them right)
correspond to some twentieth century years marked by war and the development of
ravaging excess in consumption, volume of music, daily calories consumed, etc.
--
TXR Programming Lanuage: http://nongnu.org/txr
Music DIY Mailing List: http://www.kylheku.com/diy
ADA MP-1 Mailing List: http://www.kylheku.com/mp1
Robert L.
2020-05-15 01:23:11 UTC
Post by Kaz Kylheku
TXR Lisp.
(defun bellied-p (num)
(let ((d (digits num)))
(and (= 4 (len d))
(< (+ [d 0] [d 3])
(+ [d 1] [d 2])))))
[iff [chain car bellied-p] len (ret 0)]]
(1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932
1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945
1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958
1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971
1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984
1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997
1998 1999)
Shorter.
Gauche Scheme:

(use gauche.sequence) ;; group-contiguous-sequence find-max
,print-mode pretty #t length #f width 64

(define (bellied? n)
(define (d i) (mod (div n (expt 10 i)) 10))
(> (+ (d 1) (d 2))
(+ (d 0) (d 3))))

(find-max
(group-contiguous-sequence (filter bellied? (iota 9000 1000)))
:key length)

===>
(1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931
1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943
1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955
1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967
1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979
1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
1992 1993 1994 1995 1996 1997 1998 1999)
--
The report card by the American Society of Civil Engineers showed the national
infrastructure a single grade above failure, a step from declining to the point
where everyday things simply stop working the way people expect them to.
archive.org/details/nolies
Axel Reichert
2020-05-15 18:32:50 UTC
Post by Kaz Kylheku
I suspect you misstated the requirement here; the number has a belly in
the middle (is "bellied") if the inner sum is fatter than the outer
sum.
Yes. Fortunately, because of the nice name of "bellied" it was
apparently obvious for all the reply posters.
Post by Kaz Kylheku
TXR Lisp
Looks kind of interesting.
Post by Kaz Kylheku
(and (= 4 (len d))
No need to check for this, only numbers from 1000 to 9999 get in at all.
Post by Kaz Kylheku
Don't mind the square brackets; all they do is give us Lisp-1-style
evaluation, so we can refer to function names as values without
needing #' or (function ...) and call functions without (funcall ...).
Also interesting. When I started to learn languages from the Lisp family
(I really liked the lack of syntax) I thought the Common Lisp way
inconsistent and intrusive (in comparison to Scheme or Racket), now I
appreciate as at least some minimal visual clues in the oatmeal with
Post by Kaz Kylheku
(range 1000 9999)
Coming from Python I miss this dearly.
Post by Kaz Kylheku
[iff [chain car bellied-p] len (ret 0)]
Thanks for the crystal clear explanation. There are some really nice
ideas in your approach.

Best regards

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Paul Rubin
2020-05-14 05:00:42 UTC
Post by Axel Reichert
No global state, nested function definitions, no loops, recursion (is it
tail-recursive? I think so).
Unfortunately, while most Common Lisp handle tail recursion "correctly",
the standard doesn't require it so it's preferable to use explicit
iteration. I also think it's better to break out the bellied test as a
separate function.

Here's a version that I did with the help of several folks on Freenode
#lisp, particularly `beach':

(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))

(defstruct run (start 0) (length 0))

(defun find-longest-run ()
(let ((current (make-run))
(best (make-run)))
(loop for i from 0 to 9999
do (if (bellied-p i)
(incf (run-length current))
(progn (when (> (run-length current) (run-length best))
(setf best (copy-run current)))
(setf current (make-run :start i)))))
best))

(print (find-longest-run))
paul wallich
2020-05-14 12:43:59 UTC
Post by Paul Rubin
Post by Axel Reichert
No global state, nested function definitions, no loops, recursion (is it
tail-recursive? I think so).
Unfortunately, while most Common Lisp handle tail recursion "correctly",
the standard doesn't require it so it's preferable to use explicit
iteration. I also think it's better to break out the bellied test as a
separate function.
Here's a version that I did with the help of several folks on Freenode
(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))
(defstruct run (start 0) (length 0))
(defun find-longest-run ()
(let ((current (make-run))
(best (make-run)))
(loop for i from 0 to 9999
do (if (bellied-p i)
(incf (run-length current))
(progn (when (> (run-length current) (run-length best))
(setf best (copy-run current)))
(setf current (make-run :start i)))))
best))
(print (find-longest-run))
Am I the only one whose sense of elegance is miffed by the repeated
updates of the maximum run length in this and the OP's original version?
Seems to me it would look nicer to only check and update when a run is
over. (But that could require some extra state, so maybe my sense of
elegance is just badly calibrated.)

paul
2020-05-14 16:32:58 UTC
Post by paul wallich
Post by Paul Rubin
(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))
(defstruct run (start 0) (length 0))
(defun find-longest-run ()
(let ((current (make-run))
(best (make-run)))
(loop for i from 0 to 9999
do (if (bellied-p i)
(incf (run-length current))
(progn (when (> (run-length current) (run-length best))
(setf best (copy-run current)))
(setf current (make-run :start i)))))
best))
(print (find-longest-run))
Am I the only one whose sense of elegance is miffed by the repeated
updates of the maximum run length in this and the OP's original version?
Seems to me it would look nicer to only check and update when a run is
over. (But that could require some extra state, so maybe my sense of
elegance is just badly calibrated.)
It would seem fairly simple to adapt this solution from Pau Rubin to work
the way you suggest. The RUN struct already records the starting location,
so you could always use that to compute the run length when you need it.
Paul Rubin
2020-05-14 23:24:51 UTC
Post by paul wallich
Am I the only one whose sense of elegance is miffed by the repeated
updates of the maximum run length in this and the OP's original version?
Hmm, yes I see, at first I was only bothered by the copy-structure that
I hadn't originally realized would be needed, because I thought that
ordinary setf would already copy the values. Yes it's a little ugly. I
wrote C and C++ versions that did the same thing. Maybe a
not-too-cluttered fix is possible.

Axel, two comments on your version besides the tail recursion: 1) I
think it is better for the function to not print anything, but rather,
just return the value and let the caller print it. 2) It is also imho
preferable to remember and return where the run begins, since you had to
know it anyway to compute the length.
paul wallich
2020-05-15 15:23:13 UTC
Post by Paul Rubin
Post by paul wallich
Am I the only one whose sense of elegance is miffed by the repeated
updates of the maximum run length in this and the OP's original version?
Hmm, yes I see, at first I was only bothered by the copy-structure that
I hadn't originally realized would be needed, because I thought that
ordinary setf would already copy the values. Yes it's a little ugly. I
wrote C and C++ versions that did the same thing. Maybe a
not-too-cluttered fix is possible.
The easiest fix I could see involved doing lots of comparisons with
zero-length runs. Once you have the state of "are we in a run" it gets
ugly. Other thing is to make sure you aren't checking multiple runs that
end at the same place...

paul
2020-05-15 16:27:42 UTC
Post by paul wallich
Post by Paul Rubin
Post by paul wallich
Am I the only one whose sense of elegance is miffed by the repeated
updates of the maximum run length in this and the OP's original version?
Hmm, yes I see, at first I was only bothered by the copy-structure that
I hadn't originally realized would be needed, because I thought that
ordinary setf would already copy the values. Yes it's a little ugly. I
wrote C and C++ versions that did the same thing. Maybe a
not-too-cluttered fix is possible.
The easiest fix I could see involved doing lots of comparisons with
zero-length runs. Once you have the state of "are we in a run" it gets
ugly. Other thing is to make sure you aren't checking multiple runs that
end at the same place...
I thought of a clever outline of an approach that should be fairly compact, but not terribly efficient.

(reduce #'max
(let ((counter 0))
(mapcar (lambda (current) (if current (incf counter) (setq counter 0)))
(mapcar #'bellied-p (iota ...)))))

Almost fully functional except for the counter state introduced by the LET.
Axel Reichert
2020-05-15 19:04:24 UTC
(reduce #'max
(let ((counter 0))
(mapcar (lambda (current) (if current (incf counter) (setq counter 0)))
(mapcar #'bellied-p (iota ...)))))
Now, THAT is cool!

In the meantime I did some minor cosmetic changes and I am currently at:

(defun belliedp (i)
(labels ((digit (place) (mod (truncate i place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))

(defun bellied (start end)
(apply #'max
(let ((length 0))
(mapcar (lambda (e) (if e (incf length) (setf length 0)))
(mapcar #'belliedp
(alexandria:iota (- end start -1)
:start start))))))

(bellied 1000 9999)

The style guides I have read recommend belliedp instead of bellied-p
(single word). labels seems to be more general than flet, I like 10,
100, 1000 better than the solution with expt and 1, 2, 3 (less mental
burden to understand the code). setf instead of setq (reminds me too
much on Emacs Lisp).

Now your functional approach brings me back to one of my original
questions: Chaining more higher-order functions would quickly bust the
right margin. Any best practices for this? Using some "compose" or
"chaining" library (if there is one)?

Many thanks and best regards,

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
2020-05-15 22:33:55 UTC
Post by Axel Reichert
(reduce #'max
(let ((counter 0))
(mapcar (lambda (current) (if current (incf counter) (setq counter 0)))
(mapcar #'bellied-p (iota ...)))))
Now, THAT is cool!
(defun belliedp (i)
(labels ((digit (place) (mod (truncate i place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))
(defun bellied (start end)
(apply #'max
(let ((length 0))
(mapcar (lambda (e) (if e (incf length) (setf length 0)))
(mapcar #'belliedp
(alexandria:iota (- end start -1)
:start start))))))
(bellied 1000 9999)
Minor point:
It is better to use (reduce #'max ...) vs (apply #'max ...) because REDUCE works with lists
of arbitrary size, whereas APPLY can run into the call-arguments-limit of the Common Lisp implementation.

Per the standard the call-arguments-limit can be as low as 50, although most current
Common Lisp implmentations have higher limits. SBCL's is gigantic, over four quintillion.
But to be save, REDUCE is recommended.

I also later realized that one could eliminate one of the list traversals by folding the belliedp
function into the lambda expression that does the counting.
Axel Reichert
2020-05-15 23:15:27 UTC
better to use (reduce #'max ...) vs (apply #'max ...) because
Ah, great, I forgot to ask about the motivation for reduce, because it
did not seem necessary to me.
SBCL's is gigantic, over four quintillion. But to be save, REDUCE is
recommended.
folding the belliedp function into the lambda
Sounds good, will try.

Thanks!

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Nelson Alexandra
2020-05-15 23:30:55 UTC
Post by Axel Reichert
[...]
Now your functional approach brings me back to one of my original
questions: Chaining more higher-order functions would quickly bust the
right margin. Any best practices for this? Using some "compose" or
"chaining" library (if there is one)?
The shell piplining in your first post
<***@axel-reichert.de> reminds me on arrow macros.

Using taruss' version (with his hint to remove one mapcar by "folding"
belliedp into the lambda expression):

(let ((c 0))
(->>
(rutils:range 1000 9999)
(mapcar (lambda (n) (if (bellied-p n) (incf c) (setq c 0))))
(reduce #'max)))

See for example
(ql:system-apropos "arrow"),
https://vindarel.github.io/cl-torrents/tutorial.html#orgb1aa808,
http://langnostic.inaimathi.ca/posts/more-on-clj#arrow-macros,
https://github.com/hipeta/arrow-macros/blob/master/arrow-macros.lisp.
Axel Reichert
2020-05-17 20:29:40 UTC
Nelson Alexandra <***@i2pn2.org> writes:

[Chaining, composing, pipelining]
Post by Nelson Alexandra
The shell piplining in your first post
Sounds interesting.
Post by Nelson Alexandra
(let ((c 0))
(->>
(rutils:range 1000 9999)
(mapcar (lambda (n) (if (bellied-p n) (incf c) (setq c 0))))
(reduce #'max)))
Great! That is what I was looking for. And very readable in my opinion.
Post by Nelson Alexandra
See for example [...]
Thanks for the pointer, much appreciated!

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Paul Rubin
2020-05-16 00:58:26 UTC
Post by Axel Reichert
(mapcar (lambda (e) (if e (incf length) (setf length 0)))
Now your functional approach
I'd say this is a mostly imperative approach because of the incf/setf,
that happens to use mapcar as loop control. A more pure functional
approach would be to have the helper function keep the current length
and max length as arguments, then reduce that over the iota list:

(defun iota (from to &optional (a nil))
(if (= from to) a (iota (1+ from) to (cons from a))))

(defun axel2 (start end)
(flet ((go (lengths n)
(destructuring-bind
(current-length max-length) lengths
(if (bellied-p n)
(let ((new-length (1+ current-length)))
(list new-length (max max-length new-length)))
(list 0 max-length)))))
(cadr (reduce #'go (iota start end) :initial-value '(0 0)))))

(print (axel2 1000 10000))

Since the function arg of reduce takes just two args, I made the first
arg (the accumulation value as it were) a two-element list and used
destructuring-bind to unpack it. I thought of using a defstruct but
that looked messy. Maybe there is a better way. I'm not much of a CL
user so I could be overlooking something.
Post by Axel Reichert
Chaining more higher-order functions would quickly bust the right
margin. Any best practices for this?
CL is really more of an imperative language and you should probably try
Scheme or Racket if you want a functional-style Lisp, or Haskell if you
want to go full-on functional. But, basically, you could use flet or
labels to give names to those internal functions, instead of having so
many nested lambdas. You can also split forms across lines etc.
SLIME does a good job indenting the parts.

For Haskell, learnyouahaskell.com is a good place to start.
Paul Rubin
2020-05-16 23:18:15 UTC
A more pure functional approach would be to have the helper function
keep the current length and max length as arguments, then reduce that
I did another Haskell version using that approach, very slightly golfed:

bellied n = b+c > a+d where
di k = (n`quot`10^k)`rem`10
[a,b,c,d] = map di [0..3]

main = print . snd \$ foldl go (0,0) [1000..9999] where
go (current, longest) n =
let new = if bellied n then current+1 else 0
in (new, max new longest)

Note: foldl in Haskell is similar to reduce in Lisp.
Axel Reichert
2020-05-17 20:25:57 UTC
Post by Paul Rubin
Post by Axel Reichert
(mapcar (lambda (e) (if e (incf length) (setf length 0)))
I'd say this is a mostly imperative approach because of the incf/setf,
that happens to use mapcar as loop control.
Hm, true enough.
Post by Paul Rubin
try Scheme or Racket if you want a functional-style Lisp
When I investigated various Lisps, I also played around with Racket a
little bit. I liked it, kind of Scheme with batteries included. But if
Lisps in general are niche, than Racket is niche-niche. The
documentation seems great, but I liked the wealth of knowledge than can
be found from various different sources for Common Lisp. And Portacle is
a really nice package, with Emacs, SBCL, (ma)git, Quicklisp and Slime up
and running in a snap, which sealed the deal.

If Common Lisp's ballast starts to annoy me, I will also have a closer
look at Clojure, probably only to be annoyed by the Java ballast. (-;
Post by Paul Rubin
split forms across lines etc. SLIME does a good job indenting the
parts.
Yes, I know. Thanks!

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Paul Rubin
2020-05-18 11:03:53 UTC
Post by Axel Reichert
When I investigated various Lisps, I also played around with Racket a
little bit. I liked it, kind of Scheme with batteries included...
I guess I wonder what got you interested in Lisp in the first place, and
what you are hoping to get out of it. For application development CL is
a reasonable choice. For language geekery per se, I'd look at newer
variants and descendants. CL has lots of creature comforts,
distinguished history, and impressive implementation technology, but in
this day and age it has become old fashioned.
Post by Axel Reichert
If Common Lisp's ballast starts to annoy me, I will also have a closer
look at Clojure, probably only to be annoyed by the Java ballast. (-;
I haven't pursued it but I've heard something about a Clojure
implementation that's been decoupled from the JVM and can run on its
own. While we're at it I'd like to see Purescript without any
Javascript dependencies ;).

Here's my current version of the bellied problem: seeing them evolve has
been interesting. I got stylistic help from IRC, as before. You might
like hanging out there, #lisp on freenode.

================================================================

(defun iota (start end)
(loop :for i :from start :below end :collecting i))

(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(destructuring-bind (a b c d) (mapcar #'digit '(1000 100 10 1))
(> (+ b c) (+ a d)))))

(defun longest-run-length (start end)
(flet ((go (lengths n)
(destructuring-bind
(current-length max-length) lengths
(let ((new-length
(if (bellied-p n) (1+ current-length) 0)))
(list new-length (max max-length new-length))))))
(cadr (reduce #'go (iota start end) :initial-value '(0 0)))))

(print (longest-run-length 1000 10000))
Axel Reichert
2020-05-18 22:12:59 UTC
Post by Paul Rubin
I guess I wonder what got you interested in Lisp in the first place,
and what you are hoping to get out of it.
- Mechanical engineer with a (for the profession ...) strong
mathematical/theoretical background/interest

- Been a hacker early on: Basic, Commodore 64 Assembler, Pascal,
Fortran, Perl, Shell, Python. Focus on quick hacking, never got any
solid computer science background.

- Discussion with computer science professor who was surprised that I
did not even know about programming paradigms and suggested some
"canonical" representatives, which I do not recall any more.

- .emacs tinkerer since 1995, so I decided that Lisp as a canonical
representative of the opposite side of the spectrum (relative to
Fortran, and of similar age) might not only be interesting, but also
useful to learn.

- This judgement proved correct and in the process of diving into some
solid computer science by means of Lisp books I got hooked by the
functional stuff and the mostly consistent syntax (or lack of it)
prevalent in Lisps (plus macros, though they are still some miles to
go for me). Python now looks and feels cobbled together. Was it
foo.sorted() and sort(foo)? Or foo.sort() and sorted(foo)? List
comprehensions feel like a nightmare (which is why I stay away from
the loop DSL in Lisp).

[Common Lisp]
Post by Paul Rubin
old fashioned
I don't care. It is just for pet projects. "Factor" seemed also
interesting, probably to the point of mind bending.
Post by Paul Rubin
current version of the bellied problem: seeing them evolve has been
interesting
Yes. I think it is a nice problem for stylistic/idiomatic studies.

Best regards

Axel
Paul Rubin
2020-05-19 01:51:10 UTC
Post by Axel Reichert
- Mechanical engineer with a (for the profession ...) strong
mathematical/theoretical background/interest
Ah, cool.
Post by Axel Reichert
- This judgement proved correct and in the process of diving into some
solid computer science by means of Lisp books
Ermph, I'd say topics in computer science are mostly things like
algorithms. PLT (programming language theory) is a CS topic but a) it
is somewhat niche, and b) Lisp sad to say is not that important in it
these days.

But yes, you should learn Lisp (which dialect isn't that important);
every programmer should. To misquote somebody, never having used Lisp
is like never having heard a symphony.

You should look at SICP if you haven't: https://mitpress.mit.edu/sicp

It uses Scheme, but you can do most of the exercises in CL if your
implementation supports tail recursion.
Post by Axel Reichert
Post by Paul Rubin
old fashioned
I don't care. It is just for pet projects. "Factor" seemed also
interesting, probably to the point of mind bending.
I haven't used Factor but I didn't have the impression it was that
interesting. It's Lisp-like but with Forth-style syntax. One thing
we learn from Lisp is that surface syntax is not that important.

After Lisp you should try Haskell. Precise static types give you a
completely different take on programming. I won't say better or worse
since that's an endless debate, with ach approach having its good
points. But, you should try to get some familiarity with both, and let

You might like Simon Peyton Jones' book on functional language
implementation:

https://www.microsoft.com/en-us/research/publication/the-implementation-of-functional-programming-languages/
Axel Reichert
2020-05-20 21:19:44 UTC
Post by Paul Rubin
Ermph, I'd say topics in computer science are mostly things like
algorithms.
Sorry, bear with me, I am a layman. To me, a book like "The little
Schemer" full of recursion and ending with the Y combinator or
"Programming Language Pragmatics" or a (German) book about programming
paradigms IS computer science. I readily admit that I definitely lack a
good overview about data structures and algorithms. Any pointers on good
references are appreciated.

(On a side note, many people probably think likewise that engineering
for the most part is about machinery, levers and gears ...)
Post by Paul Rubin
https://mitpress.mit.edu/sicp
Sure, found that already. The exercises are (from a quick glance) quite
ambitious with a spare time/hobbyist time budget. I am not a full-time
student.

["Factor"]
Post by Paul Rubin
Lisp-like but with Forth-style syntax
Yes. Wrapping my mind around the stack-based concept will be
interesting. Very "functional", meta-programming is possible, refactoring
is easy, dynamic typing, post-fix instead of pre-fix ...
Post by Paul Rubin
static types give you a completely different take on programming. I
won't say better or worse since that's an endless debate
I think I basically understand the pros and cons, but I am fully in the
dynamic camp, even if the static language is supported by Hindley-Milner
type inference.
Post by Paul Rubin
https://www.microsoft.com/en-us/research/publication/the-implementation-of-functional-programming-languages/
Thanks, I partially read some interesting sections.

Best regards

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Nelson Alexandra
2020-05-20 22:33:51 UTC
Post by Axel Reichert
Post by Paul Rubin
Ermph, I'd say topics in computer science are mostly things like
algorithms.
Sorry, bear with me, I am a layman. To me, a book like "The little
Schemer" full of recursion and ending with the Y combinator or
"Programming Language Pragmatics" or a (German) book about programming
paradigms IS computer science. I readily admit that I definitely lack a
good overview about data structures and algorithms. Any pointers on
good references are appreciated.
For algorithms & data structure you might have a look
Axel Reichert
2020-05-21 10:34:06 UTC
Post by Nelson Alexandra
For algorithms & data structure you might have a look
Spot on! Not too academic, and even for Lisp (I would have expected
either more maths or more Java). Thanks a lot!

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
2020-05-21 01:12:23 UTC
Post by Axel Reichert
Post by Paul Rubin
https://mitpress.mit.edu/sicp
Sure, found that already. The exercises are (from a quick glance) quite
ambitious with a spare time/hobbyist time budget. I am not a full-time
student.
Well, at MIT SICP (or 6.001 as it was called) had the reputation of being a somewhat
challenging class for many of the student who took it.

The book itself is very literately written and has a very nice description of the role of abstraction as a way of managing complexity. And although (at MIT) used as an
introductory CS class, I think a lot of what is there can only be really appreciated
once one has a lot of experience in the field.
luserdroog
2020-05-27 04:43:59 UTC
Post by Axel Reichert
I readily admit that I definitely lack a
good overview about data structures and algorithms. Any pointers on good
references are appreciated.
Aho, Hopcroft, Ullman, /Data Structures and Algorithms/. It's old
but excellently written, and not a big book. Another great book
about algorithmic thinking is Jon Bentley's /Programming Pearls/.
g***@gmail.com
2020-05-28 20:53:10 UTC
I had a go in miniBASE!

the 2nd number is >= the 1st!

lisp7 0 0 [?]

0 1
0 2
0 3
1 1
1 2
1 3
2 2
2 3
3 3

lisp7 A C
-clear D
-s C D
-if
-eq D 4
-let D 0
-s A B
-let A B
-endif
-if
-eq A 4
-else
-if
-bigger D A
-print A
-print D
-echo newline
-endif
-clear B
-clear C
-lisp7 A D

-------------------- TRACE --------------------

37 lisp7 0 0
1 A=0
1 C=0
lisp7 0 0

37 1 clear D
37 2 s C D
45 s 0 D
2 D=1
s 0 1

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 0 1
1 A=0
1 C=1
lisp7 0 1

37 1 clear D
37 2 s C D
46 s 1 D
2 D=2
s 1 2

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 0 2
1 A=0
1 C=2
lisp7 0 2

37 1 clear D
37 2 s C D
47 s 2 D
2 D=3
s 2 3

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 0 3
1 A=0
1 C=3
lisp7 0 3

37 1 clear D
37 2 s C D
48 s 3 D
2 D=4
s 3 4

37 3 if
37 4 eq D 4
37 5 let D 0
37 6 s A B
45 s 0 B
2 B=1
s 0 1

37 7 let A B
37 8 endif
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 1 0
1 A=1
1 C=0
lisp7 1 0

37 1 clear D
37 2 s C D
45 s 0 D
2 D=1
s 0 1

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 1 1
1 A=1
1 C=1
lisp7 1 1

37 1 clear D
37 2 s C D
46 s 1 D
2 D=2
s 1 2

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 1 2
1 A=1
1 C=2
lisp7 1 2

37 1 clear D
37 2 s C D
47 s 2 D
2 D=3
s 2 3

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 1 3
1 A=1
1 C=3
lisp7 1 3

37 1 clear D
37 2 s C D
48 s 3 D
2 D=4
s 3 4

37 3 if
37 4 eq D 4
37 5 let D 0
37 6 s A B
46 s 1 B
2 B=2
s 1 2

37 7 let A B
37 8 endif
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 2 0
1 A=2
1 C=0
lisp7 2 0

37 1 clear D
37 2 s C D
45 s 0 D
2 D=1
s 0 1

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 2 1
1 A=2
1 C=1
lisp7 2 1

37 1 clear D
37 2 s C D
46 s 1 D
2 D=2
s 1 2

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 2 2
1 A=2
1 C=2
lisp7 2 2

37 1 clear D
37 2 s C D
47 s 2 D
2 D=3
s 2 3

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 2 3
1 A=2
1 C=3
lisp7 2 3

37 1 clear D
37 2 s C D
48 s 3 D
2 D=4
s 3 4

37 3 if
37 4 eq D 4
37 5 let D 0
37 6 s A B
47 s 2 B
2 B=3
s 2 3

37 7 let A B
37 8 endif
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 3 0
1 A=3
1 C=0
lisp7 3 0

37 1 clear D
37 2 s C D
45 s 0 D
2 D=1
s 0 1

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 3 1
1 A=3
1 C=1
lisp7 3 1

37 1 clear D
37 2 s C D
46 s 1 D
2 D=2
s 1 2

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 3 2
1 A=3
1 C=2
lisp7 3 2

37 1 clear D
37 2 s C D
47 s 2 D
2 D=3
s 2 3

37 3 if
37 4 eq D 4
37 9 if
37 10 eq A 4
37 12 if
37 13 bigger D A
37 14 print A
37 15 print D
37 16 echo newline
37 17 endif
37 18 clear B
37 19 clear C
37 20 lisp7 A D
37 lisp7 3 3
1 A=3
1 C=3
lisp7 3 3

37 1 clear D
37 2 s C D
48 s 3 D
2 D=4
s 3 4

37 3 if
37 4 eq D 4
37 5 let D 0
37 6 s A B
48 s 3 B
2 B=4
s 3 4

37 7 let A B
37 8 endif
37 9 if
37 10 eq A 4
37 11 else

Nelson Alexandra
2020-05-19 14:27:59 UTC
Post by Paul Rubin
Here's my current version of the bellied problem: seeing them evolve
has been interesting. I got stylistic help from IRC, as before. You
might like hanging out there, #lisp on freenode.
================================================================
(defun iota (start end)
(loop :for i :from start :below end :collecting i))
(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(destructuring-bind (a b c d) (mapcar #'digit '(1000 100 10 1))
[...]
(defun longest-run-length (start end)
(flet ((go (lengths n)
(destructuring-bind
(current-length max-length) lengths
(let ((new-length
(if (bellied-p n) (1+ current-length) 0)))
(list new-length (max max-length new-length))))))
(cadr (reduce #'go (iota start end) :initial-value '(0 0)))))
(print (longest-run-length 1000 10000))
In (ql:system-apropos "quicksearch") from Takaya Ochiai is a
utility (sadly not in its own micro package), map-reduce:

(defun map-reduce (reducer mapper sequence)
(reduce
reducer
(map 'vector
(lambda (x)
(lambda () (funcall mapper x))))
sequence)

mapper is applied to each element in the sequence, for each element a

Example from the documentation:

(map-reduce #'+
(lambda (x) (expt x 2)) ;<- each thread computes this
'(1 2 3 4))
==> 30

Now one could try something like

(map-reduce
#'merge-two-sub-solutions
#'solve-i-th-sub-problem
(divide big-problem-in-sequence-of-smaller-problems))

For example.

;;; 8< cut start

(in-package :rtl-user)

(defun longest-run (m pred init)
(funcall (lambda (l)
(list (length l) (first l)))
(reduce (lambda (l1 l2)
(if (> (length l2) (length l1)) l2 l1))
(reduce (lambda (a n)
(if (funcall pred a n)
(cons (cons n (car a)) (cdr a))
(cons (list n) a)))
m
:initial-value (list (list init))))))

(defun bellied-p (n)
(flet ((digit (place) (mod (truncate n place) 10)))
(> (+ (digit 10) (digit 100))
(+ (digit 1) (digit 1000)))))

(defun merge-two-bellied-solutions (l1 l2)
(if (= (1+ (car l1)) (car l2))
(list (cadr l2) (+ (car l1) (car l2)))
(if (> (car l1) (car l2)) l1 l2)))

(defun map-reduce (reducer mapper sequence)
(reduce
reducer
(map 'vector
(lambda (x)
(lambda () (funcall mapper x))))
sequence)

(map-reduce
#'merge-two-bellied-solutions ; merge
(lambda (m) (longest-run m (lambda (a n) (= (1- n) (caar a))) 1)) ; conquer in separate threads
(rutils:partition-with ; divide
(alexandria:iota 10 :start 1000 :step 1000)
(remove-if-not 'bellied-p (alexandria:iota (1+ (- 9999 1000)) :start
1000)) :test #'<=))

;;; >8 cut end

==> (80 1999)

For a (1+ (- 9999 1000)) long sequence it is silly to use threads.

For big sequences some laziness (packages series, folio2, clazy, ...)
could be useful to have lower memory footprint.
Axel Reichert
2020-05-15 18:40:46 UTC
Post by Paul Rubin
Axel, two comments on your version besides the tail recursion: 1) I
think it is better for the function to not print anything, but rather,
just return the value and let the caller print it.
Regarding tail recursion: I am too proud (now that I think I grokked it)
to let it go. AFAIK Steel Bank Common Lisp does it correctly if
possible. You are right about the print, should be moved outside. Also,
like you and various other posters did, I should use some "flet" or
"labels" for the tiny helper function extracting the digits.

Best regards

Axel
--
-X- | in memoriam John Conway
--X | 1937-2020
XXX | A glider from his "Game of Life"
Paul Rubin
2020-05-14 05:05:02 UTC
Post by Axel Reichert
This is a neat and simple one-liner which took me 5 minutes to cobble
together instead of 5 hours ...
Here is my Haskell version:

import Data.Function
import Data.List
import Data.Ord

gby :: (a -> Bool) -> [a] -> [[a]]
gby f xs = filter (f . head) . groupBy ((==)`on`f) \$ xs

bellied n = digit 100 + digit 10 > digit 1000 + digit 1
where
digit place = (n`quot`place)`rem`10

main = print (head xs, length xs)
where
xs = maximumBy (comparing length) . (gby bellied) \$ [0..9999]
Robert L.
2020-05-15 20:43:58 UTC
Post by Axel Reichert
(defun bellied-checker (start end)
(labels ((bellied-checker-helper (n n-max this-length max-length)
(if (<= n n-max)
(if (> (+ (mod (truncate n 10) 10)
(mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000)))
(bellied-checker-helper (1+ n) n-max
(1+ this-length) max-length)
(bellied-checker-helper (1+ n) n-max 0
(max this-length max-length)))
(print max-length)))))
(bellied-checker-helper start end 0 0))
Shorter.

Gauche Scheme:

(define (bellied? n)
(define (d i) (mod (div n (expt 10 i)) 10))
(> (+ (d 1) (d 2))
(+ (d 0) (d 3))))

(let loop ((n 1000) (count 0) (best-n 0) (best-count 0))
(if (> n 9999)
(list best-count best-n)
(let ((count (if (bellied? n) (+ 1 count) 0)))
(apply loop (+ 1 n) count
(if (> count best-count)
(list n count)
(list best-n best-count))))))

===>
(80 1999)
2020-05-17 04:35:23 UTC
Post by Axel Reichert
Now the task is to find the longest, uninterrupted sequence of bellied
numbers within all 4-digit number, hence from 1000 to 9999.
This is a very similar problem to the "longest consecutive sequence"
problem that has become a popular question in computer programming
job interviews.
Post by Axel Reichert
1. I am quite sure that the wrong result is due to the pretty printing
of the Lisp output, such that line wrapping occurs and the regex fails
to count the subsequent 1s correctly. How could I (in general, not for
this problem) increase the line width for "formatted" output by the Lisp
printer?
The *PRINT-RIGHT-MARGIN* variable controls this for the pretty
printer. It has the confusing interpretation of NIL denoting "some
reasonable value," so to take effect you have to set it really high:

--8<---------------cut here---------------start------------->8---
CL-USER> (count #\Newline (let ((*print-right-margin* most-positive-fixnum)) (format nil "~S" (make-list 10000))))
0
CL-USER>
--8<---------------cut here---------------end--------------->8---

Alternatively, you can just disable pretty printing:

--8<---------------cut here---------------start------------->8---
CL-USER> (count #\Newline (let ((*print-pretty* nil)) (format nil "~A" (make-list 10000))))
0
CL-USER>
--8<---------------cut here---------------end--------------->8---

Another thing that is unwanted is that ~A will print the parentheses
of the list. With FORMAT you can ditch the pretty-printing and have
really fine-grained control over the output, suitable for later
parsing:

--8<---------------cut here---------------start------------->8---
CL-USER> (format nil "~{~4,'0D~^ ~}" '(1 12 123 1234))
"0001 0012 0123 1234"
CL-USER>
--8<---------------cut here---------------end--------------->8---

The FORMAT domain-specific language is very thorough (and I suspect
is computationally as powerful as push-down automata, without taking
into account its ability to call arbitrary Lisp functions). Drew
McDermott is a big detractor and provides an alternative:

http://www.cs.yale.edu/homes/dvm/format-stinks.html

And speaking of writing Fortran in any language:

--8<---------------cut here---------------start------------->8---
(defun bellied? (n)
(declare (fixnum n))
(let (upper lower thousands hundreds tens ones)
(setf (values upper lower) (truncate n 100)
(values thousands hundreds) (truncate upper 10)
(values tens ones) (truncate lower 10))
(< (+ thousands ones) (+ hundreds tens))))

(defun find-bellied ()
(do ((i 1000 (1+ i))
(is-bellied? nil (bellied? (1+ i)))
(longest-start 0)
(longest-end 0)
(current-start))
((< 9999 i) (list longest-start (1- longest-end)))
(if is-bellied?
(unless current-start
(setf current-start i))
(when current-start
(when (< (- longest-end longest-start)
(- i current-start))
(setf longest-start current-start
longest-end i))
(setf current-start nil)))))
--8<---------------cut here---------------end--------------->8---

Currently I am about to embark on learning numerical analysis with
Fortran 2018. The 2018 standard seems to have a lot of good ways to
work with arrays, and declarative parallelism.
--
Software engineering services in Los Angeles https://oneofus.la
Axel Reichert
2020-05-19 07:35:50 UTC
Post by Vladimir Sedach
This is a very similar problem to the "longest consecutive sequence"
problem that has become a popular question in computer programming
job interviews.
I promise I will not apply for these. (-;
Post by Vladimir Sedach
(count #\Newline (let ((*print-pretty* nil))
(format nil "~A" (make-list 10000))))
Thanks!
Post by Vladimir Sedach
With FORMAT you can ditch the pretty-printing and have really
fine-grained control over the output
I know in general, but this seemed to be the wrong approach for the
problem in question anyway.
Post by Vladimir Sedach
http://www.cs.yale.edu/homes/dvm/format-stinks.html
Interesting.

Best regards

Axel
Raymond Wiker
2020-05-17 18:49:11 UTC
Axel Reichert <***@axel-reichert.de> writes:
[ ... ]
Post by Axel Reichert
No global state, nested function definitions, no loops, recursion (is it
tail-recursive? I think so).
From an experienced Lisper's point of view: How can this be improved
(indentation, modularization, ...)?
If you have read this far, am I already thankful and would be even more
so for each and every criticism!
Best regards
Axel (who fortunately for himself and the rest of world is not a professional
programmer)
Here's a couple:

(defun bellied-number-p (number)
(let ((dig0 (mod number 10))
(dig1 (mod (truncate number 10) 10))
(dig2 (mod (truncate number 100) 10))
(dig3 (truncate number 1000)))
(> (+ dig1 dig2) (+ dig0 dig3))))

;;; (slightly) extended loop
(defun find-longest-sequence (start end test)
(let ((longest-sequence-start nil)
(longest-sequence-length 0))
(flet ((test-for-new-longest-sequence (start end)
(let ((seq-length (- end start)))
(when (> seq-length longest-sequence-length)
(setf longest-sequence-start start
longest-sequence-length seq-length)))))
(loop with seq-start = nil
for num from start below end
for right-num = (funcall test num)
when right-num
do (unless seq-start
(setf seq-start num))
unless right-num
do (when seq-start
(test-for-new-longest-sequence seq-start num)
(setf seq-start nil))
finally (when seq-start
(test-for-new-longest-sequence seq-start end)))
(values longest-sequence-start longest-sequence-length))))

#||
(find-longest-sequence 1000 10000 'bellied-number-p)
||#

;;; silly functional:
(defun iota (b e)
(loop for i from b below e
collect i))

(defun find-longest-sequence/functional (begin end test)
(reduce (lambda (a b)
(if (> (cdr b) (cdr a))
b a))
(remove-if-not test
(let ((numbers (iota begin end)))
(let ((changes
(cons begin
(remove nil
(maplist
(lambda (list indexes)
(unless (eq (first list) (second list))
(second indexes)))
(mapcar test
numbers)
numbers)))))
(mapcar (lambda (a b)
(cons a (- b a)))
changes
(cdr changes))))
:key 'car)))

(find-longest-sequence/functional 1000 10000 'bellied-number-p)
Robert L.
2020-05-23 05:32:10 UTC
Post by Axel Reichert
(defun bellied-checker (start end)
(labels ((bellied-checker-helper (n n-max this-length max-length)
(if (<= n n-max)
(if (> (+ (mod (truncate n 10) 10)
(mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000)))
(bellied-checker-helper (1+ n) n-max
(1+ this-length) max-length)
(bellied-checker-helper (1+ n) n-max 0
(max this-length max-length)))
(print max-length)))))
(bellied-checker-helper start end 0 0))
Shorter.

Gauche Scheme:

(use util.match) ;; match-lambda*

(define (bellied? n)
(define (d i) (mod (div n (expt 10 i)) 10))
(> (+ (d 1) (d 2))
(+ (d 0) (d 3))))

(fold
(match-lambda*
[(n (count best-count best-n))
(let ((count (if (bellied? n) (+ 1 count) 0)))
(cons count
(if (> count best-count)
(list count n)
(list best-count best-n))))])
'(0 0 0)
(iota 9000 1000))

===>
(0 80 1999)
Jeff Barnett
2020-05-24 06:30:21 UTC
Post by Robert L.
Post by Axel Reichert
(defun bellied-checker (start end)
(labels ((bellied-checker-helper (n n-max this-length max-length)
(if (<= n n-max)
(if (> (+ (mod (truncate n 10) 10)
(mod (truncate n 100) 10))
(+ (mod n 10) (truncate n 1000)))
(bellied-checker-helper (1+ n) n-max
(1+ this-length) max-length)
(bellied-checker-helper (1+ n) n-max 0
(max this-length max-length)))
(print max-length)))))
(bellied-checker-helper start end 0 0))
Shorter.
(use util.match) ;; match-lambda*
(define (bellied? n)
(define (d i) (mod (div n (expt 10 i)) 10))
(> (+ (d 1) (d 2))
(+ (d 0) (d 3))))
(fold
(match-lambda*
[(n (count best-count best-n))
(let ((count (if (bellied? n) (+ 1 count) 0)))
(cons count
(if (> count best-count)
(list count n)
(list best-count best-n))))])
'(0 0 0)
(iota 9000 1000))
===>
(0 80 1999)
Why do you think yours is shorter? The original is 12 lines while yours
is 13 plus 2 blanks. By the way, these "use" directives are about as low
level as you can get. Why doesn't the system load whatever is used? Is
your toy designed for less then megabyte memory machines. [There's two
questions buried in here.]
--
Jeff Barnett