From: No_spamming@noWhere_7073.org   
      
   On 7/7/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)   
   >   
   >   
   > In Forth?   
      
   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)   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)