futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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>
This commit is contained in:
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
guix/ui.scm
View File

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

5
tests/ui.scm
View File

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