(in-package :clf)

;; я выделяю по массиву на каждую примитивную переменную. Надо
;; отдельно обмолвиться, что данный подход сильно зависит от ячейки,
;; поэтому классы называются соответственно с суффиксами типа `-pv'

;; note: заграничные ячейки слева и справа в один ряд
;; note: ячейки нумеруются СЛЕВА НАПРАВО, СНИЗУ ВВЕРХ

(defclass grid2d-pv ()
  (;; количество ячеек
   (cells-amount-x :initarg :cells-amount-x
		   :initform (error "необходимо задать количество ячеек по x")
		   :reader cells-amount-x)
   (cells-amount-y :initarg :cells-amount-y
		   :initform (error "необходимо задать количество ячеек по y")
		   :reader cells-amount-y)
   ;; характеристики сетки
   (iteration :initarg :iteration
	      :initform 0
	      :accessor iteration)
   (time :initarg :time
	 :initform 0.0d0
	 :accessor grid-time)
   ;; массив ячеек
   (cells :accessor cells)
   ;; граничные условия
   (left-boundary-condition :initarg :left-boundary-condition
			    :initform (error "не задано левое ГУ")
			    :reader left-boundary-condition)
   (right-boundary-condition :initarg :right-boundary-condition
			     :initform (error "не задано правое ГУ")
			     :reader right-boundary-condition)
   (top-boundary-condition :initarg :top-boundary-condition
			   :initform (error "не задано верхнее ГУ")
			   :reader top-boundary-condition)
   (bottom-boundary-condition :initarg :bottom-boundary-condition
			      :initform (error "не задано нижнее ГУ")
			      :reader bottom-boundary-condition)))

(defmethod initialize-instance :after ((grid grid2d-pv) &key &allow-other-keys)
  ;; создать сам массив
  (setf (cells grid)
	(make-array (list (2+ (cells-amount-x grid))
			  (2+ (cells-amount-y grid)))
		    :element-type 'cell2d-pv))
  ;; создать все его элементы
  (loop for i from -1 to (1+ (cells-max-x grid)) do
       (loop for j from -1 to (1+ (cells-max-y grid)) do
	    ;;(format t "~d:~d" i j) (newline)
	    (setf (cell grid (index i j))
		  (make-dummy-cell 'cell2d-pv))))
  )

;; Акцессоры и мутаторы для элементов сетки
;; note: у меня такое чувство, будто мутаторами я пользоваться не буду

(defmethod cell ((grid grid2d-pv) (index cell-index))
  (aref (cells grid) (1+ (x-index index)) (1+ (y-index index))))

(defmethod (setf cell) ((new cell2d-pv) (grid grid2d-pv) (index cell-index))
  (setf (aref (cells grid) (1+ (x-index index)) (1+ (y-index index)))
	(clone new)))

(defmethod (setf cell) ((new primitive-variables) (grid grid2d-pv) (index cell-index))
  (setf (var-vector (cell grid index))
	(var-vector new)))

(defmethod (setf cell) ((new cell-coordinates) (grid grid2d-pv) (index cell-index))
  (setf (coord-vector (cell grid index))
	(coord-vector new)))

(defmethod (setf cell) ((new cell-size) (grid grid2d-pv) (index cell-index))
  (setf (size-vector (cell grid index))
	(size-vector new)))

;; дополнительные акцессоры для сетки

(defun cells-max-x (grid)
  (1- (cells-amount-x grid)))

(defun cells-max-y (grid)
  (1- (cells-amount-y grid)))

(defun nodes-max-x (grid)
  (cells-amount-x grid))

(defun nodes-max-y (grid)
  (cells-amount-y grid))



;; функции, необходимые для инициализации сетки
;; сразу скажу, что это старые функции, которые выполняются лишь один раз, и больше не требуются
;; вообще, если по-хорошему, то надо заменить все хэши на двумерные массивы, но мне лень

(defun thick (k n coef)
  "thick (k n coef)

Cтепенная функция сгущения узлов вдоль границы, как в Solver3.
k - номер узла, n - всего узлов, coef - коэффициент сгущения узлов"
  (expt (/ k n) (abs coef)))

;; функция приближённого определения центра масс ячейки (среднее
;; арифметическое координат нод)
(defun determine-mass-center (nodes i j)
  (let* ((coords (list (gethash (list i j) nodes)
		       (gethash (list (1+ i) j) nodes)
		       (gethash (list i (1+ j)) nodes)
		       (gethash (list (1+ i) (1+ j)) nodes)))
	 (sum (apply #'coord+ coords))
	 (x (/ (x-coord sum) 4))
	 (y (/ (y-coord sum) 4)))
    (coord x y)))

;; определение размера ячейки с учётом того, что заграничные ячейки
;; должны иметь тот же размер, что и ближайшие к границе
(defun determine-x-size (centers i j)
  (let* ((left-coord (gethash (list (1- i) j) centers))
	 (right-coord (gethash (list (1+ i) j) centers)))
    (/ (distance left-coord right-coord)
       2)))

(defun determine-y-size (centers i j)
  (let* ((bottom-coord (gethash (list i (1- j)) centers))
	 (top-coord (gethash (list i (1+ j)) centers)))
    (/ (distance top-coord bottom-coord)
       2)))

;; собственно функция инициализации сетки
(defmethod init-grid ((grid grid2d-pv)
		      &key ((:left-border-coord x1)) ((:right-border-coord x2))
			top-border-line bottom-border-line
			thickening-coef-x thickening-coef-y)
  (unless (and x1 x2)
    (error "надо задать левую и правую границу по координате x: :x1 :x2"))
  (unless (and top-border-line bottom-border-line)
    (error "надо определить функции, задающие вернюю и нижнюю линии: :top-border-line :bottom-border-line"))
  (unless (and thickening-coef-x thickening-coef-y)
    (error "надо задать коэффициенты поджатия по осям: :thickening-coef-x :thickening-coef-y"))

  (let ((x-coefs (loop for i from 0 to (nodes-max-x grid)
		    collect (thick i (cells-amount-x grid) thickening-coef-x)))
	(y-coefs (loop for i from 0 to (nodes-max-y grid)
		    collect (thick i (cells-amount-y grid) thickening-coef-y)))
	(nodes (make-hash-table :test #'equal)) ; хэш с координатами узлов
	(cell-centers (make-hash-table :test #'equal)) ; хэш с координатами центров ячеек
	)

    ;; находим координаты узлов при помощи коэффициентов поджатия x-coefs и y-coefs
    (loop for i from 0 to (nodes-max-x grid) do
	 (let* ((x (+ x1 (* (nth i x-coefs)
			    (- x2 x1))))
		(y1 (funcall bottom-border-line x))
		(y2 (funcall top-border-line x)))
	   (loop for j from 0 to (nodes-max-y grid) do
		(let ((y (+ y1 (* (nth j y-coefs)
				  (- y2 y1)))))
		  (setf (gethash (list i j) nodes)
			(coord x y))))))

    ;; находим центры ячеек
    (loop for i from 0 to (cells-max-x grid) do
	 (loop for j from 0 to (cells-max-y grid) do
	      (setf (gethash (list i j) cell-centers)
		    (determine-mass-center nodes i j))))

    ;; определяем центры заграничных ячеек (кстати не совсем верно)
    (loop for j from 0 to (cells-max-y grid) do
	 (progn
	   ;; слева
	   (let ((cell-coord (gethash (list 0 j) cell-centers)))
	     (setf (gethash (list -1 j) cell-centers)
		   (coord (- (* 2 x1)
			     (x-coord cell-coord))
			  (y-coord cell-coord))))
	   ;; справа
	   (let ((cell-coord (gethash (list (cells-max-x grid) j) cell-centers)))
	     (setf (gethash (list (1+ (cells-max-x grid)) j) cell-centers)
		   (coord (- (* 2 x2)
			     (x-coord cell-coord))
			  (y-coord cell-coord))))))
    
    (loop for i from 0 to (cells-max-x grid) do
	 (progn
	   ;; снизу
	   (let ((cell-coord (gethash (list i 0) cell-centers)))
	     (setf (gethash (list i -1) cell-centers)
		   (coord (x-coord cell-coord)
			  (- (* 2 (funcall bottom-border-line (x-coord cell-coord))) 
			     (y-coord cell-coord)))))
	   ;; сверху
	   (let ((cell-coord (gethash (list i (cells-max-y grid)) cell-centers)))
	     (setf (gethash (list i (1+ (cells-max-y grid))) cell-centers)
		   (coord (x-coord cell-coord)
			  (- (* 2 (funcall top-border-line (x-coord cell-coord)))
			     (y-coord cell-coord)))))))

    ;; задаём координаты и размеры ячеек сетки и заграничных ячеек
    ;; сначала устанавливаем в центре, а потом сносим из приграничных за границу
    (loop for stage in '(center borders) do
	 (loop for i from -1 to (1+ (cells-max-x grid)) do
	      (loop for j from -1 to (1+ (cells-max-y grid)) do
		 ;; везде, кроме углов
		   (unless (and (not (<= 0 i (cells-max-x grid)))
				(not (<= 0 j (cells-max-y grid))))
		     (setf (cell grid (index i j)) ;; устанавливаем центры
			   (gethash (list i j) cell-centers))
		     (cond ((= i -1) ;; левые заграничные
			    (when (equal stage 'borders)
			      (setf (x-size (cell grid (index i j)))
				    (x-size (cell grid (index (1+ i) j))))
			      (setf (y-size (cell grid (index i j)))
				    (y-size (cell grid (index (1+ i) j)))))
			    )
			   ((= i (1+ (cells-max-x grid))) ;; правые заграничные
			    (when (equal stage 'borders)
			      (setf (x-size (cell grid (index i j)))
				    (x-size (cell grid (index (1- i) j))))
			      (setf (y-size (cell grid (index i j)))
				    (y-size (cell grid (index (1- i) j)))))
			    )
			   ((= j -1) ;; нижние заграничные
			    (when (equal stage 'borders)
			      (setf (x-size (cell grid (index i j)))
				    (x-size (cell grid (index i (1+ j)))))
			      (setf (y-size (cell grid (index i j)))
				    (y-size (cell grid (index i (1+ j))))))
			    )
			   ((= j (1+ (cells-max-y grid))) ;; верхние заграничные
			    (when (equal stage 'borders)
			      (setf (x-size (cell grid (index i j)))
				    (x-size (cell grid (index i (1- j)))))
			      (setf (y-size (cell grid (index i j)))
				    (y-size (cell grid (index i (1- j))))))
			    )
			   (t ;; центральные
			    (when (equal stage 'center)
			      (setf (x-size (cell grid (index i j)))
				    (determine-x-size cell-centers i j))
			      (setf (y-size (cell grid (index i j)))
				    (determine-y-size cell-centers i j)))))))))
    ))

(defmethod print-grid ((grid grid2d-pv) &key (print-out-border nil))
  ;; информация о текущем состоянии
  (format t "# Iterations: ~a~%" (iteration grid))
  (format t "# Time: ~a~%" (grid-time grid))
  ;; заголовки
  (format t "NX NY ")
  (print-headers t (cell grid (index 0 0)))
  (newline)
  ;; ячейки
  (loop for i from -1 to (1+ (cells-max-x grid)) do
;  (loop for i from -1 to (1+ max-x) do ; bit-hack для тестов
       (loop for j from -1 to (1+ (cells-max-y grid)) do
	    (let ((cell (cell grid (index i j)))
		  (print-flag nil))
	      ;; исключаем углы
	      (unless (and (not (<= 0 i (cells-max-x grid)))
			   (not (<= 0 j (cells-max-y grid))))
		(cond (;; границы
		       (or (= i -1)
			   (= i (1+ (cells-max-x grid)))
			   (= j -1)
			   (= j (1+ (cells-max-y grid))))
		       (when print-out-border (setf print-flag t)))
		      (t ;; центральные
		       (setf print-flag t))))
	      (when print-flag
		(format t "~d ~d " i j)
	        (print-content t cell :with-headers nil)
		(newline))))))

(defmethod clone ((grid grid2d-pv))
  ;; создадим новую сетку
  (let ((newgrid (make-instance 'grid2d-pv
				:cells-amount-x (cells-amount-x grid)
				:cells-amount-y (cells-amount-y grid)
				:left-boundary-condition (left-boundary-condition grid)
				:right-boundary-condition (right-boundary-condition grid)
				:bottom-boundary-condition (bottom-boundary-condition grid)
				:top-boundary-condition (top-boundary-condition grid)
				:iteration (iteration grid)
				:time (grid-time grid))))
    ;; скопируем все ячейки
    (loop for i from -1 to (1+ (cells-max-x grid)) do
	 (loop for j from -1 to (1+ (cells-max-y grid)) do
	      (unless (and (not (<= 0 i (cells-max-x grid)))
			   (not (<= 0 j (cells-max-y grid))))
		(setf (cell newgrid (index i j))
		      (cell grid (index i j))))))
    ;; вернём новую сетку в качестве значения
    newgrid))