;;; -*- Lisp -*-
;;; msortx.lisp multiplication of polyns based on copying coefs into arrays.

(eval-when (compile load) (declaim (optimize (speed 3)(safety 0))))

;; sort X+Y various ways.

(defun make-rac(n d) 
  ;;make random list of length n with spacing k, with 0<k<=d between elements
  ;; with coefficients that are random integers between 1 and d
  (let ((exps (make-array n :element-type 'fixnum))
					;(coefs(make-array n :element-type 'double-float))
	(coefs(make-array n :element-type 'fixnum))
	
	(v (random d)))
    (dotimes (i n (cons exps coefs))
      (setf (aref coefs i)(+ 1 (random d))
	;(+ 1.0d0 (random d))
	)
      (setf (aref exps i)v)
      (setf v (+ 1 v (random d))))))


(defun test(n m)
  (setf x (make-rac n 5))
  (setf y (make-rac m 5))
  (format t "~% hash time-ar")
    (time (mulhasha x y)))

;; multiply two polynomials via a hash table. For comparison

(defun mulhasha (x y);; will not be normalized [could have 0 coeffs]
  (let ((ans (make-hash-table))
	(xexps (car x))
	(xcoefs (cdr x))
	(yexps (car y))
	(ycoefs (cdr y))
	(xei 0)
	(xco 0.0d0))
    (declare (type (simple-array fixnum (*)) xexps yexps)
	     ;;  (type (simple-array double-float(*)) xcoefs ycoefs)
	     (type (simple-array fixnum(*)) xcoefs ycoefs)
	     (fixnum xei)
	     (optimize (speed 3)(safety 0))
;;	     (:explain :types)
	     )
    (dotimes (i (length xexps) (sorthash ans))
      (declare (fixnum i))
      (setf xei (aref xexps i))
      (setf xco (aref xcoefs i))
      (dotimes (j (length yexps))
	(declare (fixnum j))
	(incf (gethash (+ xei(aref yexps j)) ans ;0.0d0
		       0)
	      (*  xco (aref ycoefs j)))))))

(defun mulhashb (x y);; will not be normalized [could have 0 coeffs]
  (let ((ans (make-hash-table))
	(xexps (car x))
	(xcoefs (cdr x))
	(yexps (car y))
	(ycoefs (cdr y))
	(xei 0)
	(xco 0)
	(loc nil))
    (declare (type (simple-array fixnum (*)) xexps yexps)
	     ;;  (type (simple-array double-float(*)) xcoefs ycoefs)
	     (type (simple-array fixnum(*)) xcoefs ycoefs)
	     (fixnum xei xco xy)
	     (optimize (speed 3)(safety 0))
;;	     (:explain :types)
	     )
    (dotimes (i (length xexps) (sorthashb ans))
      (declare (fixnum i))
      (setf xei (aref xexps i))
      (setf xco (aref xcoefs i))
      (setf xy 0)
      (dotimes (j (length yexps))
	(declare (fixnum j))
	(setf loc (gethash (setf xy (+ xei(aref yexps j))) ans ;0.0d0
			   ))
	(if (null loc)(setf (gethash xy ans) (list (* xco (aref ycoefs j)) ))
	  (setf (car loc)
	    (+ (the fixnum (car loc))
	       (*  xco (aref ycoefs j)))))))))

(defun sorthash(h) ;; utility for mulhasha
  (let ((ans nil))
    (maphash #'(lambda (i v)(push (cons i v) ans)) h)
    (sort ans #'< :key #'car)))

(defun sorthashb(h) ;; utility for mulhashb
  (let ((ans (make-array 10 :adjustable t :fill-pointer 0)))
    (maphash #'(lambda (i v)(setf (cdr v)(car v))
		       (setf (car v) i)
		       (unless (= (car v) 0) ;; normalize! remove 0 coefs
			 (vector-push-extend v ans)))
	     h)
    (sort ans #'< :key #'car)))