dmitriy/april_day_2026
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

lisp lang solution № 2

Browse source
This commit is contained in:
Дмитрий Голондарев 2026-03-28 21:44:22 +03:00
parent 5983863625
commit 8a3a35064e
2 changed files with 120 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

67
lisp/ros/solution2.ros Executable file
View file

@ -0,0 +1,67 @@
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- "$0" "$@"
|#
(progn ;;init forms
(ros:ensure-asdf)
#+quicklisp(ql:quickload '() :silent t)
)
(defpackage :ros.script.subset-sum.3983202585
(:use :cl))
(in-package :ros.script.subset-sum.3983202585)
(defun ten-to-bin (x len mask)
"Преобразует число в список бит (оптимизировано через сдвиги)"
(declare (optimize (speed 3) (safety 0))
(type fixnum x len)
(type (simple-array fixnum (*)) mask))
(let ((i 0))
(declare (type fixnum i))
;; Пока число не 0 и мы в пределах len
(loop while (and (> x 0) (< i len)) do
(setf (aref mask i) (logand x 1)) ; (x & 1)
(setf x (ash x -1)) ; (x >>= 1)
(incf i))
i))
(defun calculate-sum (len numbers mask)
(declare (type fixnum len)
(type (simple-array fixnum (*)) numbers mask))
(let ((sum 0))
(declare (type fixnum sum))
(dotimes (i len sum)
(setf sum (the fixnum (+ sum (the fixnum (* (aref numbers i) (aref mask i)))))))))
(defun find-sum (target len numbers mask)
"Перебирает все комбинации (через битовые маски) для поиска целевой суммы."
(declare (optimize (speed 3) (safety 0))
(type (simple-array fixnum(*)) numbers)
(type (simple-array fixnum(*)) mask)
(type fixnum target)
(type (integer 0 62) len))
(let* ((total-combinations
(1- (ash 1 (the (integer 0 61) (- len 1))))))
(declare (type fixnum total-combinations))
(format t "~D~%" total-combinations)
(loop for i from 0 to total-combinations do
(let* ((current-sum (calculate-sum (ten-to-bin i len mask) numbers mask)))
(declare (type fixnum current-sum))
(when (= current-sum target)
(return mask))))))
(defun main (&rest args)
(if (or (< (length args) 5) (> (length args) 30))
(progn
(format t "ER: input parameters~%")
(uiop:quit 1))
(progn
(let* ((len (length args))
(target (parse-integer (first args)))
(mask (make-array len :element-type 'fixnum :initial-element 0))
(numbers (coerce (mapcar #'parse-integer (rest args)) '(simple-array fixnum (*)))))
(find-sum target len numbers mask)))))

53
lisp/solution2.lisp Normal file
View file

@ -0,0 +1,53 @@
(defun ten-to-bin (x len mask)
"Преобразует число в список бит (оптимизировано через сдвиги)"
(declare (optimize (speed 3) (safety 0))
(type fixnum x len)
(type (simple-array fixnum (*)) mask))
(let ((i 0))
(declare (type fixnum i))
;; Пока число не 0 и мы в пределах len
(loop while (and (> x 0) (< i len)) do
(setf (aref mask i) (logand x 1)) ; (x & 1)
(setf x (ash x -1)) ; (x >>= 1)
(incf i))
i))
(defun calculate-sum (len numbers mask)
(declare (type fixnum len)
(type (simple-array fixnum (*)) numbers mask))
(let ((sum 0))
(declare (type fixnum sum))
(dotimes (i len sum)
(setf sum (the fixnum (+ sum (the fixnum (* (aref numbers i) (aref mask i)))))))))
(defun find-sum (target len numbers mask)
"Перебирает все комбинации (через битовые маски) для поиска целевой суммы."
(declare (optimize (speed 3) (safety 0))
(type (simple-array fixnum(*)) numbers)
(type (simple-array fixnum(*)) mask)
(type fixnum target)
(type (integer 0 62) len))
(let* ((total-combinations
(1- (ash 1 (the (integer 0 61) (- len 1))))))
(declare (type fixnum total-combinations))
(format t "~D~%" total-combinations)
(loop for i from 0 to total-combinations do
(let* ((current-sum (calculate-sum (ten-to-bin i len mask) numbers mask)))
(declare (type fixnum current-sum))
(when (= current-sum target)
(return mask))))))
(defun main (args)
(if (or (< (length args) 5) (> (length args) 30))
(progn
(format t "ER: input parameters~%")
(uiop:quit 1))
(progn
(let* ((len (length args))
(target (parse-integer (first args)))
(mask (make-array len :element-type 'fixnum :initial-element 0))
(numbers (coerce (mapcar #'parse-integer (rest args)) '(simple-array fixnum (*)))))
(find-sum target len numbers mask)))))