(in-package :cl-user) (eval-when (:compile-toplevel :load-toplevel :execute) (sb-int:defconstant-eqx opt #+swank '(optimize (speed 3) (safety 2)) #-swank '(optimize (speed 3) (safety 0) (debug 0)) #'equal) #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t) #-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))) #+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax) (defmacro define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits) ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits))) (define-int-types 2 4 7 8 15 16 31 32 62 63 64) (defconstant +mod+ 1000000007) (defmacro dbg (&rest forms) #+swank (if (= (length forms) 1) `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms)) `(format *error-output* "~A => ~A~%" ',forms `(,,@forms))) #-swank (declare (ignore forms))) (declaim (inline println)) (defun println (obj &optional (stream *standard-output*)) (let ((*read-default-float-format* 'double-float)) (prog1 (princ obj stream) (terpri stream)))) ;; BEGIN_INSERTED_CONTENTS ;; BEGIN_USE_PACKAGE (in-package :cl-user) ;;; ;;; Body ;;; ;; Reference: http://drken1215.hatenablog.com/entry/2019/03/20/202800 (defun echelon! (matrix &optional extended) "Returns the row echelon form of MATRIX by gaussian elimination and returns the rank as the second value. This function destructively modifies MATRIX." (labels ((%zerop (x) (< (abs x) 1d-9))) (destructuring-bind (m n) (array-dimensions matrix) (declare ((integer 0 #.most-positive-fixnum) m n)) (let ((rank 0)) (dotimes (target-col (if extended (- n 1) n)) (let ((pivot-row (do ((i rank (+ 1 i))) ((= i m) -1) (unless (%zerop (aref matrix i target-col)) (return i))))) (when (>= pivot-row 0) ;; swap rows (loop for j from target-col below n do (rotatef (aref matrix rank j) (aref matrix pivot-row j))) (let ((inv (/ (aref matrix rank target-col)))) (dotimes (j n) (setf (aref matrix rank j) (* inv (aref matrix rank j)))) (dotimes (i m) (unless (or (= i rank) (%zerop (aref matrix i target-col))) (let ((factor (aref matrix i target-col))) (loop for j from target-col below n do (setf (aref matrix i j) (- (aref matrix i j) (* (aref matrix rank j) factor)))))))) (incf rank)))) (values matrix rank))))) (defun solve-linear-system (matrix vector) "Solves Ax ≡ b and returns a root vector if it exists. Otherwise it returns NIL. In addition, this function returns the rank of A as the second value." (destructuring-bind (m n) (array-dimensions matrix) (declare ((integer 0 #.most-positive-fixnum) m n)) (assert (= n (length vector))) (let ((extended (make-array (list m (+ n 1)) :element-type (array-element-type matrix)))) (labels ((%zerop (x) (< (abs x) 1d-9))) (dotimes (i m) (dotimes (j n) (setf (aref extended i j) (aref matrix i j))) (setf (aref extended i n) (aref vector i))) (let ((rank (nth-value 1 (echelon! extended t)))) (if (loop for i from rank below m always (%zerop (aref extended i n))) (let ((result (make-array m :element-type (array-element-type matrix) :initial-element 0d0))) (dotimes (i rank) (setf (aref result i) (aref extended i n))) (values result rank)) (values nil rank))))))) (defun main () (let* ((a (float (read) 1d0)) (b (float (read) 1d0)) (c (float (read) 1d0)) (d (float (read) 1d0)) (e (float (read) 1d0)) (f (float (read) 1d0)) (mat (make-array '(2 2) :element-type 'double-float :initial-contents `((,a ,b) (,d ,e))))) (multiple-value-bind (res rank) (solve-linear-system mat (vector c f)) (format t "~F ~F~%" (aref res 0) (aref res 1))))) #-swank (main) ;;; ;;; Test and benchmark ;;; #+swank (defun get-clipbrd () (with-output-to-string (out) #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t) #+os-unix (run-program "xsel" '("-b" "-o") :output out :search t))) #+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname)) #+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*)) #+swank (defun run (&optional thing (out *standard-output*)) "THING := null | string | symbol | pathname null: run #'MAIN using the text on clipboard as input. string: run #'MAIN using the string as input. symbol: alias of FIVEAM:RUN!. pathname: run #'MAIN using the text file as input." (let* ((*standard-output* (or out (make-string-output-stream))) (res (etypecase thing (null (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd))) (main))) (string (with-input-from-string (*standard-input* (delete #\Return thing)) (main))) (symbol (5am:run! thing)) (pathname (with-open-file (*standard-input* thing) (main)))))) (if out res (get-output-stream-string *standard-output*)))) #+swank (defun gen-dat () (uiop:with-output-file (out *dat-pathname* :if-exists :supersede) (format out ""))) #+swank (defun bench (&optional (out (make-broadcast-stream))) (time (run *dat-pathname* out))) ;; To run: (5am:run! :sample) #+swank (it.bese.fiveam:test :sample (it.bese.fiveam:is (equal "1.000000000000000 1.000000000000000 " (run "1 1 2 1 2 3 " nil))) (it.bese.fiveam:is (equal "2.666666666666667 -0.333333333333333 " (run "2 1 5 1 2 2 " nil))))