From: zimoun <zimon.toutoune@gmail.com>
To: 45893@debbugs.gnu.org
Subject: [bug#45893] [PATCH v3 1/3] utils: Add string distance.
Date: Tue, 19 Jan 2021 22:28:08 +0100 [thread overview]
Message-ID: <20210119212810.20681-1-zimon.toutoune@gmail.com> (raw)
In-Reply-To: <20210115163732.53665-1-zimon.toutoune@gmail.com>
* guix/utils.scm (string-distance): New procedure.
(string-closest): New procedure.
* tests/utils.scm: Test it.
---
guix/utils.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
tests/utils.scm | 18 ++++++++++++++++++
2 files changed, 64 insertions(+), 1 deletion(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index f8b05e7e80..dc2259ef8c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -8,6 +8,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,6 +38,7 @@
#:use-module (guix memoization)
#:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively))
#:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
+ #:use-module ((guix combinators) #:select (fold2))
#:use-module (guix diagnostics) ;<location>, &error-location, etc.
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
@@ -114,7 +116,10 @@
call-with-decompressed-port
compressed-output-port
call-with-compressed-output-port
- canonical-newline-port))
+ canonical-newline-port
+
+ string-distance
+ string-closest))
\f
;;;
@@ -847,6 +852,46 @@ be determined."
;; raising an error would upset Geiser users
#f))))))
+\f
+;;;
+;;; String comparison.
+;;;
+
+(define (string-distance s1 s2)
+ "Compute the Levenshtein distance between two strings."
+ ;; Naive implemenation
+ (define loop
+ (mlambda (as bt)
+ (match as
+ (() (length bt))
+ ((a s ...)
+ (match bt
+ (() (length as))
+ ((b t ...)
+ (if (char=? a b)
+ (loop s t)
+ (1+ (min
+ (loop as t)
+ (loop s bt)
+ (loop s t))))))))))
+
+ (let ((c1 (string->list s1))
+ (c2 (string->list s2)))
+ (loop c1 c2)))
+
+(define* (string-closest trial tests #:key (threshold 3))
+ "Return the string from TESTS that is the closest from the TRIAL,
+according to 'string-distance'. If the TESTS are too far from TRIAL,
+according to THRESHOLD, then #f is returned."
+ (identity ;discard second return value
+ (fold2 (lambda (test closest minimal)
+ (let ((dist (string-distance trial test)))
+ (if (and (< dist minimal) (< dist threshold))
+ (values test dist)
+ (values closest minimal))))
+ #f +inf.0
+ tests)))
+
;;; Local Variables:
;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
;;; End:
diff --git a/tests/utils.scm b/tests/utils.scm
index 9bce446d98..40eaf65bbc 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -265,6 +266,23 @@ skip these tests."
string-reverse)
(call-with-input-file temp-file get-string-all)))
+(test-equal "string-distance"
+ '(0 1 1 5 5)
+ (list
+ (string-distance "hello" "hello")
+ (string-distance "hello" "helo")
+ (string-distance "helo" "hello")
+ (string-distance "" "hello")
+ (string-distance "hello" "")))
+
+(test-equal "string-closest"
+ '("hello" "hello" "helo" #f)
+ (list
+ (string-closest "hello" '("hello"))
+ (string-closest "hello" '("helo" "hello" "halo"))
+ (string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
+ (string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))
+
(test-end)
(false-if-exception (delete-file temp-file))
base-commit: 884f320e7ceb35cb8472510e47fc5f1944675d82
prerequisite-patch-id: 07abf72be0f4db9fbc19cb719d87bc1c69e8479d
--
2.29.2
next prev parent reply other threads:[~2021-01-19 21:29 UTC|newest]
Thread overview: 32+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-15 16:37 [bug#45893] [PATCH 0/2] DRAFT: Hint for options zimoun
2021-01-15 16:39 ` [bug#45893] [PATCH 1/2] scripts: search, show: Replace 'args-fold*' by 'parse-command-line' zimoun
2021-01-15 16:39 ` [bug#45893] [PATCH 2/2] guix: scripts: Add hint for option typo zimoun
2021-01-19 17:20 ` [bug#45893] [PATCH 0/2] DRAFT: Hint for options Ludovic Courtès
2021-01-19 17:35 ` zimoun
2021-01-16 0:09 ` [bug#45893] [PATCH v2 0/3] DRAFT: Hint command line typo zimoun
2021-01-16 0:26 ` [bug#45893] [PATCH v2 1/3] scripts: search, show: Replace 'args-fold*' by 'parse-command-line' zimoun
2021-01-16 0:26 ` [bug#45893] [PATCH v2 2/3] guix: scripts: Add hint for option typo zimoun
2021-01-19 17:31 ` [bug#45893] [PATCH 0/2] DRAFT: Hint for options Ludovic Courtès
2021-01-16 0:26 ` [bug#45893] [PATCH v2 3/3] ui: Add command hint zimoun
2021-01-19 17:38 ` [bug#45893] [PATCH 0/2] DRAFT: Hint for options Ludovic Courtès
2021-01-19 18:01 ` zimoun
2021-01-26 20:53 ` Ludovic Courtès
2021-01-26 21:27 ` zimoun
2021-01-19 23:59 ` [bug#45893] Hint for package name: too slow! zimoun
2021-01-20 9:49 ` [bug#45893] Hint for package name: full matrix iteration zimoun
2021-01-26 21:00 ` [bug#45893] [PATCH 0/2] DRAFT: Hint for options Ludovic Courtès
2021-01-26 21:44 ` zimoun
2021-01-27 22:09 ` Ludovic Courtès
2021-01-19 21:28 ` zimoun [this message]
2021-01-19 21:28 ` [bug#45893] [PATCH v3 2/3] guix: scripts: Add hint for option typo zimoun
2021-01-19 21:28 ` [bug#45893] [PATCH v3 3/3] ui: Add hint for command typo zimoun
2021-01-26 21:18 ` [bug#45893] [PATCH 0/2] DRAFT: Hint for options Ludovic Courtès
2021-01-26 21:20 ` Ludovic Courtès
2021-01-26 22:05 ` zimoun
2021-02-03 11:28 ` bug#45893: " Ludovic Courtès
2021-02-03 12:15 ` [bug#45893] " zimoun
2021-02-24 23:47 ` option hint for all commands? zimoun
2021-03-01 14:07 ` Hartmut Goebel
2021-02-04 19:53 ` bug#46303: Typo helper doesn't always know which command is missing Leo Famulari
2021-02-04 21:29 ` zimoun
2021-02-04 23:08 ` [bug#45893] " zimoun
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210119212810.20681-1-zimon.toutoune@gmail.com \
--to=zimon.toutoune@gmail.com \
--cc=45893@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.