<commit_before>(in-package :jp-numeral)

;;; Conditions

(define-condition no-power-char-error (error)
  ())

(define-condition not-formattable-error (error)
  ())


;;; Accessors to the jp-numeral-table.

(defun style-to-index (style)
  (ecase style
    (:normal +TABLE-NORMAL-INDEX+)
    (:formal +TABLE-FORMAL-INDEX+)
    (:old +TABLE-OLD-INDEX+)
    (:positional +TABLE-POSITIONAL-INDEX+)))

(defun get-digit (n style)
  (assert (<= 0 n 9))
  (let ((entry (aref +digits+ n)))
    (aref entry (style-to-index style))))
     
(defun get-power (n style)
  (unless (<= +power-min+ n +power-max+)
    (error 'no-power-char-error))
  (alexandria:if-let ((a-entry (assoc n +power-alist+)))
    (aref (cdr a-entry)
	  (style-to-index style))
    (assert nil (n) "~D does not have an apropriate char" n)))

(defun get-minus-sign (style)
  (aref +minus-sign+ (style-to-index style)))
  
(defun get-parts-of (style)
  (aref +fraction-parts-of+ (style-to-index style)))

(defun get-radix-point (style)
  (aref +radix-point+ (style-to-index style)))

(defun get-yen (style)
  (aref +yen+ (style-to-index style)))

(defun get-sen (style)
  (aref +sen+ (style-to-index style)))

(defun get-wari (style)
  (aref +wari+ (style-to-index style)))


;;; Writers

(defun translate-digit (c style)
  (ecase c
    (#\0 (get-digit 0 style))
    (#\1 (get-digit 1 style))
    (#\2 (get-digit 2 style))
    (#\3 (get-digit 3 style))
    (#\4 (get-digit 4 style))
    (#\5 (get-digit 5 style))
    (#\6 (get-digit 6 style))
    (#\7 (get-digit 7 style))
    (#\8 (get-digit 8 style))
    (#\9 (get-digit 9 style))))

(defun print-positional (stream object style digits-after-dot scale radix-point-str)
  (loop with lispstr
       = (with-standard-io-syntax
	   (typecase object
	     (integer (format nil "~D" object))
	     (ratio (format nil "~D/~D" (numerator object) (denominator object)))
	     (float (format nil "~,v,vF" digits-after-dot scale object))
	     (t (error 'not-formattable-error))))
     for c across lispstr
     as jp-str = 
     (case c
       ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
	(translate-digit c style))
       (#\. radix-point-str)
       (#\- (get-minus-sign style))
       (#\/ (get-parts-of style))
       (otherwise
	(error 'not-formattable-error)))
     do (write-string jp-str stream)))


(defun make-digits4-string (digits4 style)
  (declare (type (integer 0 9999) digits4))
  (let ((fill-1 (ecase style
		  (:normal nil)
		  ((:formal :old) t))))
    (with-output-to-string (stream)
      (flet ((put-digit (digit pow)
	       (ecase digit
		 ((2 3 4 5 6 7 8 9)
		  (write-string (get-digit digit style) stream)
		  (write-string (get-power pow style) stream))
		 (1 (ecase pow
		      ((2 3)
		       (when fill-1
			 (write-string (get-digit digit style) stream)))
		      (1 nil)
		      (0 (write-string (get-digit digit style) stream)))
		    (write-string (get-power pow style) stream))
		 (0 nil))))
	(multiple-value-bind (d3 d3-rest) (floor digits4 1000)
	  (put-digit d3 3)
	  (multiple-value-bind (d2 d2-rest) (floor d3-rest 100)
	    (put-digit d2 2)
	    (multiple-value-bind (d1 d0) (floor d2-rest 10)
	      (put-digit d1 1)
	      (put-digit d0 0))))))))

(defun print-jp-integer (stream object style)
  (declare (type integer object))
  (loop with strs = nil
     for power from 0 by 4
     for (rest digits4) = (multiple-value-list (floor object 10000))
     then (multiple-value-list (floor rest 10000))
     as digits4-str = (make-digits4-string digits4 style)
     when (plusp (length digits4-str))
     do (push (get-power power style) strs)
       (push digits4-str strs)
     while (plusp rest)
     finally (mapc #'(lambda (s) (write-string s stream)) strs)))


(defun print-jp-fraction (stream object style digits-after-dot scale
			  radix-point-str radix-point-required-p)
  (unless (<= +power-min+ (log object 10) +power-max+)
    (error 'not-formattable-error))
  (let* ((trim-zero? (not digits-after-dot))
	 (digits-after-dot (or digits-after-dot
			       (- +power-min+)))
	 (lispstr (let ((str (with-standard-io-syntax
			       (format nil "~,v,vF" digits-after-dot scale object))))
		    (if trim-zero?
			(string-right-trim '(#\0) str)
			str)))
	 (dot-pos (let ((pos (position #\. lispstr)))
		    (unless pos
		      (error 'not-formattable-error))
		    pos))
	 (int-part (parse-integer lispstr :end dot-pos))
	 (frac-part-strlen (- (length lispstr) (1+ dot-pos))))
    ;; int part
    (print-jp-integer stream int-part style)
    ;; prints '0' if needed
    (when (and (zerop int-part)
	       (or radix-point-required-p
		   (zerop frac-part-strlen)))
      (write-string (get-digit 0 style) stream))
    ;; prints '.' if needed
    (when (or radix-point-required-p
	      (and (not (zerop int-part))
		   (plusp frac-part-strlen)))
      (write-string radix-point-str stream))
    ;; frac part
    (loop for i from (1+ dot-pos) below (length lispstr)
       as c = (aref lispstr i)
       for power downfrom -1 to (- digits-after-dot)
       unless (digit-char-p c)
       do (error 'not-formattable-error)<commit_msg>fixed digits arg (2)<commit_after>(in-package :jp-numeral)

;;; Conditions

(define-condition no-power-char-error (error)
  ())

(define-condition not-formattable-error (error)
  ())


;;; Accessors to the jp-numeral-table.

(defun style-to-index (style)
  (ecase style
    (:normal +TABLE-NORMAL-INDEX+)
    (:formal +TABLE-FORMAL-INDEX+)
    (:old +TABLE-OLD-INDEX+)
    (:positional +TABLE-POSITIONAL-INDEX+)))

(defun get-digit (n style)
  (assert (<= 0 n 9))
  (let ((entry (aref +digits+ n)))
    (aref entry (style-to-index style))))
     
(defun get-power (n style)
  (unless (<= +power-min+ n +power-max+)
    (error 'no-power-char-error))
  (alexandria:if-let ((a-entry (assoc n +power-alist+)))
    (aref (cdr a-entry)
	  (style-to-index style))
    (assert nil (n) "~D does not have an apropriate char" n)))

(defun get-minus-sign (style)
  (aref +minus-sign+ (style-to-index style)))
  
(defun get-parts-of (style)
  (aref +fraction-parts-of+ (style-to-index style)))

(defun get-radix-point (style)
  (aref +radix-point+ (style-to-index style)))

(defun get-yen (style)
  (aref +yen+ (style-to-index style)))

(defun get-sen (style)
  (aref +sen+ (style-to-index style)))

(defun get-wari (style)
  (aref +wari+ (style-to-index style)))


;;; Writers

(defun translate-digit (c style)
  (ecase c
    (#\0 (get-digit 0 style))
    (#\1 (get-digit 1 style))
    (#\2 (get-digit 2 style))
    (#\3 (get-digit 3 style))
    (#\4 (get-digit 4 style))
    (#\5 (get-digit 5 style))
    (#\6 (get-digit 6 style))
    (#\7 (get-digit 7 style))
    (#\8 (get-digit 8 style))
    (#\9 (get-digit 9 style))))

(defun print-positional (stream object style digits-after-dot scale radix-point-str)
  (loop with lispstr
       = (with-standard-io-syntax
	   (typecase object
	     (integer (format nil "~D" object))
	     (ratio (format nil "~D/~D" (numerator object) (denominator object)))
	     (float (format nil "~,v,vF" digits-after-dot scale object))
	     (t (error 'not-formattable-error))))
     for c across lispstr
     as jp-str = 
     (case c
       ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
	(translate-digit c style))
       (#\. radix-point-str)
       (#\- (get-minus-sign style))
       (#\/ (get-parts-of style))
       (otherwise
	(error 'not-formattable-error)))
     do (write-string jp-str stream)))


(defun make-digits4-string (digits4 style)
  (declare (type (integer 0 9999) digits4))
  (let ((fill-1 (ecase style
		  (:normal nil)
		  ((:formal :old) t))))
    (with-output-to-string (stream)
      (flet ((put-digit (digit pow)
	       (ecase digit
		 ((2 3 4 5 6 7 8 9)
		  (write-string (get-digit digit style) stream)
		  (write-string (get-power pow style) stream))
		 (1 (ecase pow
		      ((2 3)
		       (when fill-1
			 (write-string (get-digit digit style) stream)))
		      (1 nil)
		      (0 (write-string (get-digit digit style) stream)))
		    (write-string (get-power pow style) stream))
		 (0 nil))))
	(multiple-value-bind (d3 d3-rest) (floor digits4 1000)
	  (put-digit d3 3)
	  (multiple-value-bind (d2 d2-rest) (floor d3-rest 100)
	    (put-digit d2 2)
	    (multiple-value-bind (d1 d0) (floor d2-rest 10)
	      (put-digit d1 1)
	      (put-digit d0 0))))))))

(defun print-jp-integer (stream object style)
  (declare (type integer object))
  (loop with strs = nil
     for power from 0 by 4
     for (rest digits4) = (multiple-value-list (floor object 10000))
     then (multiple-value-list (floor rest 10000))
     as digits4-str = (make-digits4-string digits4 style)
     when (plusp (length digits4-str))
     do (push (get-power power style) strs)
       (push digits4-str strs)
     while (plusp rest)
     finally (mapc #'(lambda (s) (write-string s stream)) strs)))


(defun print-jp-fraction (stream object style digits-after-dot scale
			  radix-point-str radix-point-required-p)
  (let* ((trim-zero? (not digits-after-dot))
	 (digits-after-dot (or digits-after-dot
			       (prog1 (- +power-min+)
				 (when (< (log object 10) +power-min+)
				   (error 'not-formattable-error)))))
	 (lispstr (let ((str (with-standard-io-syntax
			       (format nil "~,v,vF" digits-after-dot scale object))))
		    (if trim-zero?
			(string-right-trim '(#\0) str)
			str)))
	 (dot-pos (let ((pos (position #\. lispstr)))
		    (unless pos
		      (error 'not-formattable-error))
		    pos))
	 (int-part (parse-integer lispstr :end dot-pos))
	 (frac-part-strlen (- (length lispstr) (1+ dot-pos))))
    ;; int part
    (print-jp-integer stream int-part style)
    ;; prints '0' if needed
    (when (and (zerop int-part)
	       (or radix-point-required-p
		   (zerop frac-part-strlen)))
      (write-string (get-digit 0 style) stream))
    ;; prints '.' if needed
    (when (or radix-point-required-p
	      (and (not (zerop int-part))
		   (plusp frac-part-strlen)))
      (write-string radix-point-str stream))
    ;; frac part
    (loop for i from (1+ dot-pos) below (length lispstr)
       as c = (aref lispstr i)
       for power downfrom -1
       unless (digit-char-p c)
       do (error 'not-formattable-error)
{'fraction_non_alphanumeric': 0.16949319660816406, 'fraction_numerical': 0.021494774206270953, 'mean_word_length': 2.7222018348623855, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6570354', 'n_tokens_mistral': 4142, 'n_tokens_neox': 3691, 'n_words': 1044}