ui: 'relevance' connects regexps with a logical and.

Fixes <https://bugs.gnu.org/36763>.
Previously, the logical and connecting the regexps did not output the expected
results (introduced in 8874faaaac).

* guix/ui.scm (relevance)
[score]: Change its arguments.
[regexp->score]: New procedure.
* tests/ui.scm ("package-relevance"): Add test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
master
zimoun 2019-09-18 17:57:57 +02:00 committed by Ludovic Courtès
parent 6ec872231f
commit d2cdef6560
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 27 additions and 24 deletions

View File

@ -13,6 +13,7 @@
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1281,33 +1282,32 @@ weight of this field in the final score.
A score of zero means that OBJ does not match any of REGEXPS. The higher the
score, the more relevant OBJ is to REGEXPS."
(define (score str)
(define scores
(map (lambda (regexp)
(fold-matches regexp str 0
(lambda (m score)
(+ score
(if (string=? (match:substring m) str)
5 ;exact match
1)))))
regexps))
(define (score regexp str)
(fold-matches regexp str 0
(lambda (m score)
(+ score
(if (string=? (match:substring m) str)
5 ;exact match
1)))))
(define (regexp->score regexp)
(let ((score-regexp (lambda (str) (score regexp str))))
(fold (lambda (metric relevance)
(match metric
((field . weight)
(match (field obj)
(#f relevance)
((? string? str)
(+ relevance (* (score-regexp str) weight)))
((lst ...)
(+ relevance (* weight (apply + (map score-regexp lst)))))))))
0 metrics)))
(let ((scores (map regexp->score regexps)))
;; Return zero if one of REGEXPS doesn't match.
(if (any zero? scores)
0
(reduce + 0 scores)))
(fold (lambda (metric relevance)
(match metric
((field . weight)
(match (field obj)
(#f relevance)
((? string? str)
(+ relevance (* (score str) weight)))
((lst ...)
(+ relevance (* weight (apply + (map score lst)))))))))
0
metrics))
(reduce + 0 scores))))
(define %package-metrics
;; Metrics used to compute the "relevance score" of a package against a set

View File

@ -267,6 +267,7 @@ Second line" 24))
(gcrypt (specification->package "guile-gcrypt"))
(go (specification->package "go"))
(gnugo (specification->package "gnugo"))
(libb2 (specification->package "libb2"))
(rx (cut make-regexp <> regexp/icase))
(>0 (cut > <> 0))
(=0 zero?))
@ -283,6 +284,8 @@ Second line" 24))
(=0 (package-relevance go
(map rx '("go" "game"))))
(>0 (package-relevance gnugo
(map rx '("go" "game")))))))
(map rx '("go" "game"))))
(>0 (package-relevance libb2
(map rx '("crypto" "library")))))))
(test-end "ui")