branch: master
commit 87c8aaaf72326f0fd3c9fbb1a9dd6a050890ce3a
Author: Mario Lang <ml...@delysid.org>
Commit: Mario Lang <ml...@delysid.org>
Improve performance of poker-hand-value by a factor of 4
`cl-count' is unnecessarily expensive, as it at least uses `length' and
`nthcdr'
which we really don't need in this performance cricital code path.
Rewriting it without `cl-count' turns up another opportunity to speed up,
as we actually don't need to check the whole list to count occurances of
unique elements. For one, we can start counting from 1 (not 0) if
we encounter the first element, and we only need to check the rest of the
list of cards. Also, stop using `mapcar' with `poker-card-rank'
to allow it to actually be inlined. This turns out to make poker-hand-value
*a lot* faster. Mission accomplished.
---
packages/poker/poker.el | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/packages/poker/poker.el b/packages/poker/poker.el
index 61888ae..d2896e7 100644
--- a/packages/poker/poker.el
+++ b/packages/poker/poker.el
@@ -93,15 +93,25 @@ RANK is one of `poker-ranks' and SUIT is one of
`poker-suits'."
The result is a 24 bit integer where the leftmost 4 bits (0-8) indicate the
type
of hand, and the remaining nibbles are rank values of decisive cards.
The highest possible value is therefore #x8CBA98 and the lowest is #x053210."
- (let* ((ranks (mapcar #'poker-card-rank hand))
- (rank-counts (sort (mapcar (lambda (rank) (cons (cl-count rank ranks)
rank))
- (cl-remove-duplicates ranks))
+ (let* ((rank-counts (sort (let ((cards hand) result)
+ (while cards
+ (let ((rank (poker-card-rank (car cards))))
+ (unless (rassq rank result)
+ (push (cons (let ((count 1))
+ (dolist (card (cdr cards)
count)
+ (when (eq (poker-card-rank
card)
+ rank)
+ (setq count (1+ count)))))
+ rank)
+ result)))
+ (setq cards (cdr cards)))
+ result)
(lambda (lhs rhs) (or (> (car lhs) (car rhs))
(and (= (car lhs) (car rhs))
(> (cdr lhs) (cdr
rhs)))))))
- (ranks-length (length rank-counts)))
- (setq ranks (mapcar #'cdr rank-counts)
- rank-counts (mapcar #'car rank-counts))
+ (ranks-length (length rank-counts))
+ (ranks (mapcar #'cdr rank-counts)))
+ (setq rank-counts (mapcar #'car rank-counts))
(logior (cond
((eq ranks-length 4) #x100000)
((eq ranks-length 5)
