ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 © 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 @@ (define (relevance obj regexps metrics)
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

5
tests/ui.scm
View file

@ -267,6 +267,7 @@ (define guile-2.0.9
(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 @@ (define guile-2.0.9
(=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")