lisp lang solution №3 GOOD!

This commit is contained in:
Дмитрий Голондарев 2026-03-28 23:33:59 +03:00
parent b4279293b4
commit 48400da29a
2 changed files with 141 additions and 0 deletions

80
lisp/ros/solution3.ros Executable file
View file

@ -0,0 +1,80 @@
#!/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)
(declaim (optimize (speed 3) ; Максимальная скорость
(safety 0) ; Отключить проверку типов и границ массивов
(debug 0) ; Не сохранять данные для отладчика
(space 0))) ; Не заботиться о размере бинарника
(defun ten-to-bin (x len)
"Создает вектор бит фиксированной длины (аналог маски)."
(let ((mask (make-array len :element-type 'bit :initial-element 0)))
(loop for i from (1- len) downto 0
while (> x 0)
do (multiple-value-bind (quotient remainder) (truncate x 2)
(setf (aref mask i) remainder)
(setf x quotient)))
mask))
(defun calculate-sum (numbers-vec mask-vec)
"Считает сумму элементов вектора по маске. Использует across для векторов."
(loop for num across numbers-vec
for flag across mask-vec
when (= flag 1)
sum num))
(defun find-sum (target numbers-vec)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array fixnum (*)) numbers-vec)
(type fixnum target))
(let* ((len (length numbers-vec))
(total (1- (ash 1 len)))
(current-sum 0)
;; Массив для отслеживания текущего состояния (биты)
(bits (make-array len :element-type 'bit :initial-element 0)))
(declare (type fixnum current-sum))
;; Итерация по Коду Грея
(loop for i fixnum from 1 to total do
(let* ((gray-diff (logand i (- i))) ; Находим индекс изменяемого бита
(bit-idx (1- (integer-length gray-diff)))
(num (aref numbers-vec bit-idx)))
(declare (type fixnum bit-idx num))
;; Если бит был 0, прибавляем число, если 1 — вычитаем
(if (zerop (aref bits bit-idx))
(progn
(incf current-sum num)
(setf (aref bits bit-idx) 1))
(progn
(decf current-sum num)
(setf (aref bits bit-idx) 0)))
;; Проверка цели
(when (= current-sum target)
(format t "OK:~A~%" bits)
(return-from find-sum bits))))
(format t "NO:~%")))
(defun main (&rest args)
(let ((len (length args)))
(if (or (< len 5) (> len 30))
(progn
(format t "ER: input parameters~%")
(uiop:quit 1))
(let* ((target (parse-integer (first args)))
(numbers-vec (coerce (mapcar #'parse-integer (rest args)) 'vector)))
(find-sum target numbers-vec)))))