aoc2021-day03a Common Lisp/SBCL #3 program

;; SPDX-License-Identifier: LGPL-3.0-or-later
;; Copyright (C) 2021 Massimo Zaniboni <mzan@dokmelody.org>

(ql:quickload :trivia)     ;; common macro and functions and optimal pattern matching
(ql:quickload :alexandria) ;; common CL extensions
(ql:quickload :trivial-types)  ;; common types
(ql:quickload :defstar)    ;; add type annotations
(ql:quickload :str)        ;; Common string manipulation functions
(ql:quickload :parse-float)
(ql:quickload :iterate)
(ql:quickload :let-plus)          ;; extend "let"
(ql:quickload :array-operations)  ;; rich management of arrays
(ql:quickload :bordeaux-threads)
(ql:quickload :serapeum)

(defpackage :main
  (:import-from :alexandria)
  (:import-from :trivial-types :proper-list :tuple)
  (:use :cl :defstar :trivia :parse-float :iterate :let-plus)
  (:export main))

(in-package :main)

(declaim (type fixnum +read-buff-size+))
(defconstant +read-buff-size+ (ash 1 16))

(declaim (type fixnum +initial-bits+))
(defconstant +initial-bits+ 26)

(deftype ubyte8 () '(unsigned-byte 8))

(defun count-bits->gamma-epsilon (max-count bits# count-bits)

  (iter (for i from (- bits# 1) downto 0)
        (for cb = (aref count-bits i))
        (for e first 1 then (* e 2))
        (with mc = (/ max-count 2))
        (with gamma = 0)
        (with epsilon = 0)
        (after-each
           (cond
             ((> cb mc) (setf gamma (+ gamma e)))
             (t (setf epsilon (+ epsilon e)))))
       (finally
        (return (values (* gamma epsilon) gamma epsilon max-count bits#)))))


(defun day3a-byte-thread (s lock-s bits# cols# buffer-size)
  "Use bytes because managing *input-stream* as characters (but not normal stream files), make it too much slower (10x more slower!).
   Manage the input stream s as a shared resource."

  (declare (optimize (speed 3) (debug 0) (safety 0)))
  (declare (fixnum bits# cols# buffer-size))

    (iter
      (with count-bits = (make-array bits# :adjustable nil :element-type 'fixnum :initial-element 0))
      (declare (type (simple-array fixnum 1) count-bits))
      (with buffer = (make-array buffer-size :adjustable nil :element-type 'ubyte8))
      (declare (type (simple-array ubyte8 1) buffer))
      (with count-lines = 0)
      (for end = (the fixnum (bt:with-lock-held (lock-s) (read-sequence buffer s))))
      (declare (fixnum count-lines end))
      (until (zerop end))
      (after-each
       (iter (with j = 0)
             (for i from 0 below end)
             (declare (fixnum i j))
             (declare (dynamic-extent i j))
             (after-each
               (case (the ubyte8 (aref buffer i))
                 (49 (incf (aref count-bits j)))
                 (10 (setf j -1)))
               (incf j))
             (finally (incf count-lines (ceiling end cols#)))))
      (finally (return (values count-lines count-bits)))))

(defun* (parse-each-byte-of-the-first-line -> (values fixnum (simple-array fixnum 1))) ((s stream))

  (multiple-value-bind (bits# reverse-bits)
    (iter
      (for v in-stream s :using #'read-byte)
      (until (or (null v) (= 10 v)))
      (counting v into c)
      (collect (coerce (- v 48) 'fixnum) into bits at beginning)
      (finally (return (values c bits))))

  (declare (fixnum bits#))
  (declare (type (proper-list fixnum) reverse-bits))

  (values bits#
          (make-array bits#
                      :adjustable nil
                      :element-type 'fixnum
                      :initial-contents (nreverse reverse-bits)))))

(defun day3a-byte-main-thread (s)
  (bt:start-multiprocessing)

  (multiple-value-bind (bits# count-bits)
    (parse-each-byte-of-the-first-line s)
    (declare (fixnum bits#))
    (declare (type (simple-array fixnum 1) count-bits))
    (let* ((cols# (the fixnum (+ bits# 1)))

           (buffer-lines# (coerce (ceiling +read-buff-size+ cols#) 'fixnum))

           (buffer-size (the fixnum (* cols# buffer-lines#)))

           (cores# (serapeum:count-cpus))

           (lock-s (bt:make-lock))

           (threads
             (iter (for i from 0 below cores#)
                   (collect
                       (bt:make-thread (lambda () (day3a-byte-thread s lock-s bits# cols# buffer-size)))
                    at beginning)))

           (count-lines (coerce 1 'fixnum))
           )

         ; NOTE: I'm not using iter macro anymore because it set vars to nil,
         ; creating type problems during compilation
         (dolist (job threads)
           (multiple-value-bind
              (count-lines1 count-bits1) (bt:join-thread job)
              (declare (fixnum count-lines1))
              (declare (type (simple-array fixnum 1) count-bits1))

              (incf count-lines count-lines1)
              (dotimes (i bits#)
                (incf (aref count-bits i)
                      (aref count-bits1 i)))))

         (count-bits->gamma-epsilon count-lines bits# count-bits))))

(defun day3a-byte-main-thread-fn (fn)
  (with-open-file (s fn :element-type 'ubyte8)
    (day3a-byte-main-thread s)))

(defun main ()
  (format t "~a~%" (day3a-byte-main-thread *standard-input*)))
    

NOTES:
Linux


Sun, 23 Jan 2022 12:49:39 GMT

MAKE:
sbcl --disable-debugger --load "aoc2021_day03a.lisp-3.lisp" --eval "(sb-ext:save-lisp-and-die \"app_lisp\" :executable t  :toplevel #'main:main)"
This is SBCL 2.1.11, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
To load "trivia":
  Load 1 ASDF system:
    trivia
; Loading "trivia"

To load "alexandria":
  Load 1 ASDF system:
    alexandria
; Loading "alexandria"

To load "trivial-types":
  Load 1 ASDF system:
    trivial-types
; Loading "trivial-types"

To load "defstar":
  Load 1 ASDF system:
    defstar
; Loading "defstar"

To load "str":
  Load 1 ASDF system:
    str
; Loading "str"
...
To load "parse-float":
  Load 1 ASDF system:
    parse-float
; Loading "parse-float"

To load "iterate":
  Load 1 ASDF system:
    iterate
; Loading "iterate"

To load "let-plus":
  Load 1 ASDF system:
    let-plus
; Loading "let-plus"

To load "array-operations":
  Load 1 ASDF system:
    array-operations
; Loading "array-operations"

To load "bordeaux-threads":
  Load 2 ASDF systems:
    alexandria asdf
  Install 1 Quicklisp release:
    bordeaux-threads
; Fetching #<URL "http://beta.quicklisp.org/archive/bordeaux-threads/2020-06-10/bordeaux-threads-v0.8.8.tgz">
; 23.15KB
==================================================
23,709 bytes in 0.03 seconds (823.32KB/sec)
; Loading "bordeaux-threads"
[package bordeaux-threads]....
To load "serapeum":
  Load 7 ASDF systems:
    alexandria asdf bordeaux-threads introspect-environment
    trivia trivial-cltl2 uiop
  Install 11 Quicklisp releases:
    babel global-vars parse-declarations parse-number
    serapeum split-sequence string-case trivial-features
    trivial-file-size trivial-garbage
    trivial-macroexpand-all
; Fetching #<URL "http://beta.quicklisp.org/archive/trivial-macroexpand-all/2017-10-23/trivial-macroexpand-all-20171023-git.tgz">
; 1.92KB
==================================================
1,968 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/trivial-garbage/2021-12-30/trivial-garbage-20211230-git.tgz">
; 10.74KB
==================================================
10,996 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/trivial-file-size/2020-04-27/trivial-file-size-20200427-git.tgz">
; 3.13KB
==================================================
3,208 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/string-case/2018-07-11/string-case-20180711-git.tgz">
; 8.87KB
==================================================
9,081 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/split-sequence/2021-05-31/split-sequence-v2.0.1.tgz">
; 11.43KB
==================================================
11,705 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/parse-number/2018-02-28/parse-number-v1.7.tgz">
; 5.58KB
==================================================
5,715 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/parse-declarations/2010-10-06/parse-declarations-20101006-darcs.tgz">
; 35.80KB
==================================================
36,664 bytes in 0.03 seconds (1273.19KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/global-vars/2014-11-06/global-vars-20141106-git.tgz">
; 3.50KB
==================================================
3,581 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/trivial-features/2021-12-09/trivial-features-20211209-git.tgz">
; 11.11KB
==================================================
11,377 bytes in 0.00 seconds (0.00KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/babel/2020-09-25/babel-20200925-git.tgz">
; 266.93KB
==================================================
273,336 bytes in 0.16 seconds (1620.54KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/archive/serapeum/2021-12-30/serapeum-20211230-git.tgz">
; 219.43KB
==================================================
224,698 bytes in 0.43 seconds (510.46KB/sec)
; Loading "serapeum"
[package split-sequence]..........................
[package string-case].............................
[package org.mapcar.parse-number].................
[package trivial-garbage].........................
[package tcr.parse-declarations-1.0]..............
[package global-vars].............................
[package trivial-file-size].......................
[package trivial-macroexpand-all].................
[package babel-encodings].........................
[package babel]...................................
..................................................
[package serapeum.sum]............................
[package serapeum]................................
[package serapeum-user]...........................
[package serapeum.unlocked].......................
[package serapeum/op].............................
..................................................
..................................................
[package serapeum/vector=]........................
[package serapeum/mop]............................
[package serapeum/internal-definitions]...........
..................................................
[package serapeum/dispatch-case]..................
[package serapeum/generalized-arrays].............
[package serapeum/contrib/hooks]....
[undoing binding stack and other enclosing state... done]
[performing final GC... done]
[defragmenting immobile space... (fin,inst,fdefn,code,sym)=1312+1065+21155+21885+26203... done]
[saving current Lisp image into app_lisp:
writing 0 bytes from the read-only space at 0x50000000
writing 736 bytes from the static space at 0x50100000
writing 54214656 bytes from the dynamic space at 0x1000000000
writing 2146304 bytes from the immobile space at 0x50200000
writing 14610432 bytes from the immobile space at 0x52a00000
done]

12.68s to complete and log all make actions

COMMAND LINE:
./app_lisp 0 < aoc2021_day03a-input100000.txt

PROGRAM OUTPUT:
386463119445733053722557199393548794069517420395751036911156