Path: ...!news.nobody.at!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <No_spamming@noWhere_7073.org>
Newsgroups: comp.lang.lisp
Subject: Re: X in every language syndrome
Date: Sun, 7 Jul 2024 19:42:18 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 109
Message-ID: <v6er2n$fd6o$1@dont-email.me>
References: <v6cemu$3vogb$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Sun, 07 Jul 2024 21:42:19 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="988aed472a54273a376e5503f1be245e";
	logging-data="505048"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18fKLAcSJx6FMq8BfUPnLUX"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:LpKQbivOpK4m+1OVqHd3tSjUBx4=
Bytes: 4481

On 7/6/2024, B. Pym wrote:

> > 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.
> 
> [ He means the sum of middle digits is larger. ]
> 
> > 
> > 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)))
> 
> [ Another poster: ]
> 
> > 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)
> 
> 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)

A lower-level way.

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

(define (calc-length i)
  (do ((j i (+ j 1)))
    ((not (bellied? j)) (- j i))))

(define (longest-bellied-seq)
  (let go ((i 1000) (start 0) (len 0))
    (if (> i 9999)
      (list start len)
      (let ((new-len (calc-length i)))
        (cond ((zero? new-len) (go (+ i 1) start len))
              ((> new-len len) (go (+ i new-len) i new-len))
              (#t (go (+ i new-len) start len)))))))

  ===>
(1920 80)