[PATCH] git-download: Speed up 'git-predicate'.

[PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

Adjust 'git-predicate' to use data structures that perform better when used
with git repositories with a large number of files.

Previously when matching either a regular file or directory, 'git-predicate'
would search a list with a length equal to the number of files in the
repository. As a search operation happens for roughly every file in the
repository, this meant that the time taken to use 'git-predicate' to traverse
all the files in a repository was roughly exponential with respect to the
number of files in the repository.

Now, for matching regular files or symlinks, 'git-predicate' uses a vhash
using the inode value as the key. This should perform roughly in constant
amount of time, instead of linear with respect to the number of files in the
repository.

For matching directories, 'git-predicate' now uses a tree structure stored in
association lists. To check if a directory is in the tree, the tree is
traversed from the root. The time complexity of this depends on the shape of
the tree, but it should be an improvement on searching through the list of all
files.

* guix/git-download.scm (git-predicate): Use different data structures to
  speed up 'git-predicate' with a large number of files.
---
 guix/git-download.scm | 98 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 72 insertions(+), 26 deletions(-)

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 316835502..e26e5e91f 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:export (git-reference
             git-reference?
@@ -131,39 +132,84 @@ living at DIRECTORY.  Upon Git failure, return #f instead of a predicate.
 
 The returned predicate takes two arguments FILE and STAT where FILE is an
 absolute file name and STAT is the result of 'lstat'."
-  (define (parent-directory? thing directory)
-    ;; Return #t if DIRECTORY is the parent of THING.
-    (or (string-suffix? thing directory)
-        (and (string-index thing #\/)
-             (parent-directory? (dirname thing) directory))))
-
-  (let* ((pipe        (with-directory-excursion directory
-                        (open-pipe* OPEN_READ "git" "ls-files")))
-         (files       (let loop ((lines '()))
-                        (match (read-line pipe)
-                          ((? eof-object?)
-                           (reverse lines))
-                          (line
-                           (loop (cons line lines))))))
-         (inodes      (map (lambda (file)
-                             (let ((stat (lstat
-                                          (string-append directory "/" file))))
-                               (cons (stat:dev stat) (stat:ino stat))))
-                           files))
-         (status      (close-pipe pipe)))
+  (define (create-directory-tree files)
+    (define (directory-lists->tree directory-lists)
+      (map (lambda (top-level-dir)
+             (cons top-level-dir
+                   (directory-lists->tree
+                    (filter-map
+                     (lambda (directory-list)
+                       (if (eq? (length directory-list) 1)
+                           #f
+                           (cdr directory-list)))
+                     ;; Find all the directory lists under this top-level-dir
+                     (filter
+                      (lambda (directory-list)
+                        (equal? (car directory-list)
+                                top-level-dir))
+                      directory-lists)))))
+           (delete-duplicates
+            (map car directory-lists))))
+
+    (directory-lists->tree
+     (filter-map (lambda (path)
+                   (let ((split-path (string-split path #\/)))
+                     ;; If this is a file in the top of the repository?
+                     (if (eq? (length split-path) 1)
+                         #f
+                         ;; drop-right to remove the filename, as it's
+                         ;; just the directory tree that's important
+                         (drop-right (string-split path #\/) 1))))
+                 files)))
+
+  (define (directory-in-tree? directory tree)
+    (define (directory-list-in-tree? directory-list tree)
+      (if (eq? (length directory-list) 1)
+          (list? (member (car directory-list)
+                         (map car tree)))
+          (and=> (find (match-lambda
+                         ((top-level-dir . subtree)
+                          (equal? top-level-dir
+                                  (car directory-list))))
+                       tree)
+                 (match-lambda
+                   ((top-level-dir . subtree)
+                    (directory-list-in-tree? (cdr directory-list)
+                                             subtree))))))
+
+    (directory-list-in-tree? (string-split directory #\/)
+                             tree))
+
+  (let* ((pipe           (with-directory-excursion directory
+                           (open-pipe* OPEN_READ "git" "ls-files")))
+         (files          (let loop ((lines '()))
+                           (match (read-line pipe)
+                             ((? eof-object?)
+                              (reverse lines))
+                             (line
+                              (loop (cons line lines))))))
+         (directory-tree (create-directory-tree files))
+         (inodes-vhash   (alist->vhash
+                          (map
+                           (lambda (file)
+                             (let ((stat
+                                    (lstat (string-append directory "/" file))))
+                               (cons (stat:ino stat) (stat:dev stat))))
+                           files)))
+         (status         (close-pipe pipe)))
     (and (zero? status)
          (lambda (file stat)
            (match (stat:type stat)
              ('directory
-              ;; 'git ls-files' does not list directories, only regular files,
-              ;; so we need this special trick.
-              (any (lambda (f) (parent-directory? f file))
-                   files))
+              (directory-in-tree?
+               (string-drop file (+ 1 (string-length directory)))
+               directory-tree))
              ((or 'regular 'symlink)
               ;; Comparing file names is always tricky business so we rely on
               ;; inode numbers instead
-              (member (cons (stat:dev stat) (stat:ino stat))
-                      inodes))
+              (and=> (vhash-assq (stat:ino stat) inodes-vhash)
+                     (lambda (ino-dev)
+                       (eq? (cdr ino-dev) (stat:dev stat)))))
              (_
               #f))))))
 
-- 
2.13.0

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1.1: Type: text/plain, Size: 2295 bytes --]

To provide some anecdotal evidence on the difference this makes, I wrote
a little test script [1]. It should roughly follow how git-predicate is
used with the local-file gexp.

Running the current implementation of git-predicate on the guix
repository with 50 trials takes:

  real    0m5.374s
  user    0m4.052s
  sys     0m1.484s

Compared to the following for the patched implementation:

  real    0m8.398s
  user    0m5.040s
  sys     0m2.016s

This shows that the patched implementation has decreased the
performance. Using the real value, the test time has increased by ~3
seconds. This corresponds roughly to a change from ~0.11 seconds
previously, to ~0.17 seconds for each individual traversal of the entire
repository.

I encountered a performance issue when trying to use git-predicate with
this repository [2], which I have written a Guix package for here [3].
Instead of the 1463 files that git ls-files reports locally for the guix
repository, smart-answers contains 26732 files.

The running time with smart-answers is left as an exercise to the
reader, all I can say is that on my machine, it takes more than 40
minutes for just 1 trial.

Using this patch, running the test script with 1 trial gives:

  real    0m4.917s
  user    0m3.640s
  sys     0m1.428s

1:

(use-modules (srfi srfi-1)
             (srfi srfi-26)
             (ice-9 ftw)
             (guix git-download))

(define (test file select?)
  (let dump ((f file) (s (lstat file)))
    (case (stat:type s)
      ((regular)
       (display "."))
      ((directory)
       (for-each
        (lambda (e)
          (let* ((f (string-append f "/" e))
                 (s (lstat f)))
            (if (select? f s)
                (dump f s))))
        (scandir f (negate (cut member <> '("." ".."))) string<?)))
      ((symlink)
       (display ".")))))

(define (run-test dir trials)
  (chdir dir)
  (for-each
   (lambda (trial)
     (test dir (git-predicate dir)))
   (iota trials)))

(run-test (second (command-line))
          (string->number (third (command-line))))


2: https://github.com/alphagov/smart-answers
3:
https://github.com/alphagov/govuk-guix/blob/65c6b8f3a0f01cd6ae4b51f356b74d4472b08e70/gds/packages/govuk.scm#L1136-L1153


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 858 bytes --]

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Ludovic Courtès]

Hi Christopher,

Christopher Baines <mail@cbaines.net> skribis:

> Running the current implementation of git-predicate on the guix
> repository with 50 trials takes:
>
>   real    0m5.374s
>   user    0m4.052s
>   sys     0m1.484s
>
> Compared to the following for the patched implementation:
>
>   real    0m8.398s
>   user    0m5.040s
>   sys     0m2.016s
>
> This shows that the patched implementation has decreased the
> performance. Using the real value, the test time has increased by ~3
> seconds. This corresponds roughly to a change from ~0.11 seconds
> previously, to ~0.17 seconds for each individual traversal of the entire
> repository.
>
> I encountered a performance issue when trying to use git-predicate with
> this repository [2], which I have written a Guix package for here [3].
> Instead of the 1463 files that git ls-files reports locally for the guix
> repository, smart-answers contains 26732 files.
>
> The running time with smart-answers is left as an exercise to the
> reader, all I can say is that on my machine, it takes more than 40
> minutes for just 1 trial.
>
> Using this patch, running the test script with 1 trial gives:
>
>   real    0m4.917s
>   user    0m3.640s
>   sys     0m1.428s

So in short, the new implementation is 100 times faster on large repos
but roughly the same or slightly slower on smaller repos, right?

Thanks for fixing this!

Ludo’.

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> Adjust 'git-predicate' to use data structures that perform better when used
> with git repositories with a large number of files.
>
> Previously when matching either a regular file or directory, 'git-predicate'
> would search a list with a length equal to the number of files in the
> repository. As a search operation happens for roughly every file in the
> repository, this meant that the time taken to use 'git-predicate' to traverse
> all the files in a repository was roughly exponential with respect to the
> number of files in the repository.
>
> Now, for matching regular files or symlinks, 'git-predicate' uses a vhash
> using the inode value as the key. This should perform roughly in constant
> amount of time, instead of linear with respect to the number of files in the
> repository.
>
> For matching directories, 'git-predicate' now uses a tree structure stored in
> association lists. To check if a directory is in the tree, the tree is
> traversed from the root. The time complexity of this depends on the shape of
> the tree, but it should be an improvement on searching through the list of all
> files.

Great, more than welcome it seems.  :-)

Do you know how much the inode optimization vs. the tree structure
contributes to the performance.

> * guix/git-download.scm (git-predicate): Use different data structures to
>   speed up 'git-predicate' with a large number of files.

[...]

> +  (define (create-directory-tree files)
> +    (define (directory-lists->tree directory-lists)
> +      (map (lambda (top-level-dir)
> +             (cons top-level-dir
> +                   (directory-lists->tree
> +                    (filter-map
> +                     (lambda (directory-list)
> +                       (if (eq? (length directory-list) 1)
> +                           #f
> +                           (cdr directory-list)))
> +                     ;; Find all the directory lists under this top-level-dir
> +                     (filter
> +                      (lambda (directory-list)
> +                        (equal? (car directory-list)
> +                                top-level-dir))
> +                      directory-lists)))))
> +           (delete-duplicates
> +            (map car directory-lists))))
> +
> +    (directory-lists->tree
> +     (filter-map (lambda (path)
> +                   (let ((split-path (string-split path #\/)))
> +                     ;; If this is a file in the top of the repository?
> +                     (if (eq? (length split-path) 1)
> +                         #f
> +                         ;; drop-right to remove the filename, as it's
> +                         ;; just the directory tree that's important
> +                         (drop-right (string-split path #\/) 1))))
> +                 files)))
> +
> +  (define (directory-in-tree? directory tree)
> +    (define (directory-list-in-tree? directory-list tree)
> +      (if (eq? (length directory-list) 1)
> +          (list? (member (car directory-list)
> +                         (map car tree)))
> +          (and=> (find (match-lambda
> +                         ((top-level-dir . subtree)
> +                          (equal? top-level-dir
> +                                  (car directory-list))))
> +                       tree)
> +                 (match-lambda
> +                   ((top-level-dir . subtree)
> +                    (directory-list-in-tree? (cdr directory-list)
> +                                             subtree))))))
> +
> +    (directory-list-in-tree? (string-split directory #\/)
> +                             tree))

Note that ‘length’ and ‘list?’ are O(n).  I think ‘directory-in-tree?’
should be written using ‘match’, which would avoid that altogether.
Likewise, the (map car …) call for ‘match’.  :-)
    
I find the tree implementation hard to grasp.  Perhaps it would help to
move it outside of the ‘git-predicate’ function and perhaps decompose it
a bit more?  Thoughts?

> +         (inodes-vhash   (alist->vhash
> +                          (map
> +                           (lambda (file)
> +                             (let ((stat
> +                                    (lstat (string-append directory "/" file))))
> +                               (cons (stat:ino stat) (stat:dev stat))))
> +                           files)))

I would call it ‘inodes’ simply.  Also, we could use ‘list->set’ from
(guix sets) here.

Thank you!

Ludo’.

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1.1: Type: text/plain, Size: 1518 bytes --]

On 07/06/17 13:40, Ludovic Courtès wrote:
> Hi Christopher,
> 
> Christopher Baines <mail@cbaines.net> skribis:
> 
>> Running the current implementation of git-predicate on the guix
>> repository with 50 trials takes:
>>
>>   real    0m5.374s
>>   user    0m4.052s
>>   sys     0m1.484s
>>
>> Compared to the following for the patched implementation:
>>
>>   real    0m8.398s
>>   user    0m5.040s
>>   sys     0m2.016s
>>
>> This shows that the patched implementation has decreased the
>> performance. Using the real value, the test time has increased by ~3
>> seconds. This corresponds roughly to a change from ~0.11 seconds
>> previously, to ~0.17 seconds for each individual traversal of the entire
>> repository.
>>
>> I encountered a performance issue when trying to use git-predicate with
>> this repository [2], which I have written a Guix package for here [3].
>> Instead of the 1463 files that git ls-files reports locally for the guix
>> repository, smart-answers contains 26732 files.
>>
>> The running time with smart-answers is left as an exercise to the
>> reader, all I can say is that on my machine, it takes more than 40
>> minutes for just 1 trial.
>>
>> Using this patch, running the test script with 1 trial gives:
>>
>>   real    0m4.917s
>>   user    0m3.640s
>>   sys     0m1.428s
> 
> So in short, the new implementation is 100 times faster on large repos
> but roughly the same or slightly slower on smaller repos, right?

Yep, that's right :)



[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 858 bytes --]

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1.1: Type: text/plain, Size: 5180 bytes --]

On 07/06/17 13:52, Ludovic Courtès wrote:
> Christopher Baines <mail@cbaines.net> skribis:
> 
>> Adjust 'git-predicate' to use data structures that perform better when used
>> with git repositories with a large number of files.
>>
>> Previously when matching either a regular file or directory, 'git-predicate'
>> would search a list with a length equal to the number of files in the
>> repository. As a search operation happens for roughly every file in the
>> repository, this meant that the time taken to use 'git-predicate' to traverse
>> all the files in a repository was roughly exponential with respect to the
>> number of files in the repository.
>>
>> Now, for matching regular files or symlinks, 'git-predicate' uses a vhash
>> using the inode value as the key. This should perform roughly in constant
>> amount of time, instead of linear with respect to the number of files in the
>> repository.
>>
>> For matching directories, 'git-predicate' now uses a tree structure stored in
>> association lists. To check if a directory is in the tree, the tree is
>> traversed from the root. The time complexity of this depends on the shape of
>> the tree, but it should be an improvement on searching through the list of all
>> files.
> 
> Great, more than welcome it seems.  :-)
> 
> Do you know how much the inode optimization vs. the tree structure
> contributes to the performance.

I'll find out the actual times for without both optimizations, and with
just one of them and get back to you.

>> * guix/git-download.scm (git-predicate): Use different data structures to
>>   speed up 'git-predicate' with a large number of files.
> 
> [...]
> 
>> +  (define (create-directory-tree files)
>> +    (define (directory-lists->tree directory-lists)
>> +      (map (lambda (top-level-dir)
>> +             (cons top-level-dir
>> +                   (directory-lists->tree
>> +                    (filter-map
>> +                     (lambda (directory-list)
>> +                       (if (eq? (length directory-list) 1)
>> +                           #f
>> +                           (cdr directory-list)))
>> +                     ;; Find all the directory lists under this top-level-dir
>> +                     (filter
>> +                      (lambda (directory-list)
>> +                        (equal? (car directory-list)
>> +                                top-level-dir))
>> +                      directory-lists)))))
>> +           (delete-duplicates
>> +            (map car directory-lists))))
>> +
>> +    (directory-lists->tree
>> +     (filter-map (lambda (path)
>> +                   (let ((split-path (string-split path #\/)))
>> +                     ;; If this is a file in the top of the repository?
>> +                     (if (eq? (length split-path) 1)
>> +                         #f
>> +                         ;; drop-right to remove the filename, as it's
>> +                         ;; just the directory tree that's important
>> +                         (drop-right (string-split path #\/) 1))))
>> +                 files)))
>> +
>> +  (define (directory-in-tree? directory tree)
>> +    (define (directory-list-in-tree? directory-list tree)
>> +      (if (eq? (length directory-list) 1)
>> +          (list? (member (car directory-list)
>> +                         (map car tree)))
>> +          (and=> (find (match-lambda
>> +                         ((top-level-dir . subtree)
>> +                          (equal? top-level-dir
>> +                                  (car directory-list))))
>> +                       tree)
>> +                 (match-lambda
>> +                   ((top-level-dir . subtree)
>> +                    (directory-list-in-tree? (cdr directory-list)
>> +                                             subtree))))))
>> +
>> +    (directory-list-in-tree? (string-split directory #\/)
>> +                             tree))
> 
> Note that ‘length’ and ‘list?’ are O(n).  I think ‘directory-in-tree?’
> should be written using ‘match’, which would avoid that altogether.
> Likewise, the (map car …) call for ‘match’.  :-)

That's interesting about length and list, I'll give using match a go and
send another patch.

> I find the tree implementation hard to grasp.  Perhaps it would help to
> move it outside of the ‘git-predicate’ function and perhaps decompose it
> a bit more?  Thoughts?

Yeah, the create-directory-tree and directory-in-tree? functions are
both general purpose, would you suggest this module, or somewhere else?

>> +         (inodes-vhash   (alist->vhash
>> +                          (map
>> +                           (lambda (file)
>> +                             (let ((stat
>> +                                    (lstat (string-append directory "/" file))))
>> +                               (cons (stat:ino stat) (stat:dev stat))))
>> +                           files)))
> 
> I would call it ‘inodes’ simply.  Also, we could use ‘list->set’ from
> (guix sets) here.

Ah, cool, I'll have a look at sending a updated patch shortly.



[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 858 bytes --]

[PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

Adjust 'git-predicate' to use data structures that perform better when used
with git repositories with a large number of files.

Previously when matching either a regular file or directory, 'git-predicate'
would search a list with a length equal to the number of files in the
repository. As a search operation happens for roughly every file in the
repository, this meant that the time taken to use 'git-predicate' to traverse
all the files in a repository was roughly exponential with respect to the
number of files in the repository.

Now, for matching regular files or symlinks, 'git-predicate' uses a vhash
using the inode value as the key. This should perform roughly in constant
amount of time, instead of linear with respect to the number of files in the
repository.

For matching directories, 'git-predicate' now uses a tree structure stored in
association lists. To check if a directory is in the tree, the tree is
traversed from the root. The time complexity of this depends on the shape of
the tree, but it should be an improvement on searching through the list of all
files.

* guix/git-download.scm (git-predicate): Use different data structures to
  speed up 'git-predicate' with a large number of files.
---
 guix/git-download.scm | 99 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 73 insertions(+), 26 deletions(-)

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 316835502..f9c144a6e 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:export (git-reference
             git-reference?
@@ -125,45 +126,91 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
   "Return the file-name for packages using git-download."
   (string-append name "-" version "-checkout"))
 
+(define (create-directory-tree files)
+  (define (directory-lists->tree directory-lists)
+    (map (lambda (top-level-dir)
+           (cons top-level-dir
+                 (directory-lists->tree
+                  (filter-map
+                   (lambda (directory-list)
+                     (if (eq? (length directory-list) 1)
+                         #f
+                         (cdr directory-list)))
+                   ;; Find all the directory lists under this top-level-dir
+                   (filter
+                    (lambda (directory-list)
+                      (equal? (car directory-list)
+                              top-level-dir))
+                    directory-lists)))))
+         (delete-duplicates
+          (map car directory-lists))))
+
+  (directory-lists->tree
+   (filter-map (lambda (path)
+                 (let ((split-path (string-split path #\/)))
+                   ;; If this is a file in the top of the repository?
+                   (if (eq? (length split-path) 1)
+                       #f
+                       ;; drop-right to remove the filename, as it's
+                       ;; just the directory tree that's important
+                       (drop-right (string-split path #\/) 1))))
+               files)))
+
+(define (directory-in-tree? directory whole-tree)
+  (define directory-list-in-tree?
+    (match-lambda*
+      (((top-directory . rest) tree)
+       (if (null? rest)
+           (list? (member top-directory (map car tree)))
+           (and=> (find (match-lambda
+                          ((subtree-top-directory . subtree)
+                           (equal? subtree-top-directory
+                                   top-directory)))
+                        tree)
+                  (match-lambda
+                    ((subtree-top-directory . subtree)
+                     (directory-list-in-tree? rest subtree))))))))
+
+  (directory-list-in-tree? (string-split directory #\/)
+                           whole-tree))
+
 (define (git-predicate directory)
   "Return a predicate that returns true if a file is part of the Git checkout
 living at DIRECTORY.  Upon Git failure, return #f instead of a predicate.
 
 The returned predicate takes two arguments FILE and STAT where FILE is an
 absolute file name and STAT is the result of 'lstat'."
-  (define (parent-directory? thing directory)
-    ;; Return #t if DIRECTORY is the parent of THING.
-    (or (string-suffix? thing directory)
-        (and (string-index thing #\/)
-             (parent-directory? (dirname thing) directory))))
-
-  (let* ((pipe        (with-directory-excursion directory
-                        (open-pipe* OPEN_READ "git" "ls-files")))
-         (files       (let loop ((lines '()))
-                        (match (read-line pipe)
-                          ((? eof-object?)
-                           (reverse lines))
-                          (line
-                           (loop (cons line lines))))))
-         (inodes      (map (lambda (file)
-                             (let ((stat (lstat
-                                          (string-append directory "/" file))))
-                               (cons (stat:dev stat) (stat:ino stat))))
-                           files))
-         (status      (close-pipe pipe)))
+  (let* ((pipe           (with-directory-excursion directory
+                           (open-pipe* OPEN_READ "git" "ls-files")))
+         (files          (let loop ((lines '()))
+                           (match (read-line pipe)
+                             ((? eof-object?)
+                              (reverse lines))
+                             (line
+                              (loop (cons line lines))))))
+         (directory-tree (create-directory-tree files))
+         (inodes         (alist->vhash
+                          (map
+                           (lambda (file)
+                             (let ((stat
+                                    (lstat (string-append directory "/" file))))
+                               (cons (stat:ino stat) (stat:dev stat))))
+                           files)))
+         (directory-prefix-length (+ 1 (string-length
+                                        (canonicalize-path directory))))
+         (status         (close-pipe pipe)))
     (and (zero? status)
          (lambda (file stat)
            (match (stat:type stat)
              ('directory
-              ;; 'git ls-files' does not list directories, only regular files,
-              ;; so we need this special trick.
-              (any (lambda (f) (parent-directory? f file))
-                   files))
+              (directory-in-tree? (string-drop file directory-prefix-length)
+                                  directory-tree))
              ((or 'regular 'symlink)
               ;; Comparing file names is always tricky business so we rely on
               ;; inode numbers instead
-              (member (cons (stat:dev stat) (stat:ino stat))
-                      inodes))
+              (and=> (vhash-assq (stat:ino stat) inodes)
+                     (lambda (ino-dev)
+                       (eq? (cdr ino-dev) (stat:dev stat)))))
              (_
               #f))))))
 
-- 
2.13.1

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1.1: Type: text/plain, Size: 6139 bytes --]

On 07/06/17 13:52, Ludovic Courtès wrote:
> Christopher Baines <mail@cbaines.net> skribis:
> 
>> Adjust 'git-predicate' to use data structures that perform better when used
>> with git repositories with a large number of files.
>>
>> Previously when matching either a regular file or directory, 'git-predicate'
>> would search a list with a length equal to the number of files in the
>> repository. As a search operation happens for roughly every file in the
>> repository, this meant that the time taken to use 'git-predicate' to traverse
>> all the files in a repository was roughly exponential with respect to the
>> number of files in the repository.
>>
>> Now, for matching regular files or symlinks, 'git-predicate' uses a vhash
>> using the inode value as the key. This should perform roughly in constant
>> amount of time, instead of linear with respect to the number of files in the
>> repository.
>>
>> For matching directories, 'git-predicate' now uses a tree structure stored in
>> association lists. To check if a directory is in the tree, the tree is
>> traversed from the root. The time complexity of this depends on the shape of
>> the tree, but it should be an improvement on searching through the list of all
>> files.
> 
> Great, more than welcome it seems.  :-)
> 
> Do you know how much the inode optimization vs. the tree structure
> contributes to the performance.

I've got some more data. I ran the test script for smart-answers, and
let it complete this time:

  real    97m21.291s
  user    120m50.400s
  sys     0m31.020s

Just applying the inode optimization gives this result:

  real    90m28.116s
  user    100m44.784s
  sys     0m18.524s

I'm going to assume that using the tree structure for directories makes
up the rest of the difference. This will vary between repositories
though, I think smart answers has a unusually large directory to file ratio.

>> * guix/git-download.scm (git-predicate): Use different data structures to
>>   speed up 'git-predicate' with a large number of files.
> 
> [...]
> 
>> +  (define (create-directory-tree files)
>> +    (define (directory-lists->tree directory-lists)
>> +      (map (lambda (top-level-dir)
>> +             (cons top-level-dir
>> +                   (directory-lists->tree
>> +                    (filter-map
>> +                     (lambda (directory-list)
>> +                       (if (eq? (length directory-list) 1)
>> +                           #f
>> +                           (cdr directory-list)))
>> +                     ;; Find all the directory lists under this top-level-dir
>> +                     (filter
>> +                      (lambda (directory-list)
>> +                        (equal? (car directory-list)
>> +                                top-level-dir))
>> +                      directory-lists)))))
>> +           (delete-duplicates
>> +            (map car directory-lists))))
>> +
>> +    (directory-lists->tree
>> +     (filter-map (lambda (path)
>> +                   (let ((split-path (string-split path #\/)))
>> +                     ;; If this is a file in the top of the repository?
>> +                     (if (eq? (length split-path) 1)
>> +                         #f
>> +                         ;; drop-right to remove the filename, as it's
>> +                         ;; just the directory tree that's important
>> +                         (drop-right (string-split path #\/) 1))))
>> +                 files)))
>> +
>> +  (define (directory-in-tree? directory tree)
>> +    (define (directory-list-in-tree? directory-list tree)
>> +      (if (eq? (length directory-list) 1)
>> +          (list? (member (car directory-list)
>> +                         (map car tree)))
>> +          (and=> (find (match-lambda
>> +                         ((top-level-dir . subtree)
>> +                          (equal? top-level-dir
>> +                                  (car directory-list))))
>> +                       tree)
>> +                 (match-lambda
>> +                   ((top-level-dir . subtree)
>> +                    (directory-list-in-tree? (cdr directory-list)
>> +                                             subtree))))))
>> +
>> +    (directory-list-in-tree? (string-split directory #\/)
>> +                             tree))
> 
> Note that ‘length’ and ‘list?’ are O(n).  I think ‘directory-in-tree?’
> should be written using ‘match’, which would avoid that altogether.

I've sent an updated patch now, and I think I've made some progress
towards this.

> Likewise, the (map car …) call for ‘match’.  :-)

I'm stuck on this bit though, in the latest patch it reads:

  (list? (member top-directory (map car tree))

The list? call is just to turn the list or #f returned by member to #t
or #f. The (map car tree) converts the tree to a list of top level
directories. This bit of code is used when the last directory in the
input list has been reached (e.g. when checking for foo/bar/baz
top-directory would be baz) so the last check to perform is to check if
baz exists at the current level of the tree. Any suggestions on
restructuring this?

> I find the tree implementation hard to grasp.  Perhaps it would help to
> move it outside of the ‘git-predicate’ function and perhaps decompose it
> a bit more?  Thoughts?

I've moved it directly above git-predicate for now.

>> +         (inodes-vhash   (alist->vhash
>> +                          (map
>> +                           (lambda (file)
>> +                             (let ((stat
>> +                                    (lstat (string-append directory "/" file))))
>> +                               (cons (stat:ino stat) (stat:dev stat))))
>> +                           files)))
> 
> I would call it ‘inodes’ simply.  Also, we could use ‘list->set’ from
> (guix sets) here.

I've made the inodes-vhash -> inodes rename, but I was undecided about
using (guix sets), is there a reason you recommended it?

Thnaks for your review,

Chris





[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 858 bytes --]

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Ludovic Courtès]

Hi!

Christopher Baines <mail@cbaines.net> skribis:

> On 07/06/17 13:52, Ludovic Courtès wrote:
>> Christopher Baines <mail@cbaines.net> skribis:

[...]

>> Do you know how much the inode optimization vs. the tree structure
>> contributes to the performance.
>
> I've got some more data. I ran the test script for smart-answers, and
> let it complete this time:
>
>   real    97m21.291s
>   user    120m50.400s
>   sys     0m31.020s
>
> Just applying the inode optimization gives this result:
>
>   real    90m28.116s
>   user    100m44.784s
>   sys     0m18.524s
>
> I'm going to assume that using the tree structure for directories makes
> up the rest of the difference. This will vary between repositories
> though, I think smart answers has a unusually large directory to file ratio.

Interesting, thanks for benchmarking!

>> Likewise, the (map car …) call for ‘match’.  :-)
>
> I'm stuck on this bit though, in the latest patch it reads:
>
>   (list? (member top-directory (map car tree))
>
> The list? call is just to turn the list or #f returned by member to #t
> or #f. The (map car tree) converts the tree to a list of top level
> directories. This bit of code is used when the last directory in the
> input list has been reached (e.g. when checking for foo/bar/baz
> top-directory would be baz) so the last check to perform is to check if
> baz exists at the current level of the tree. Any suggestions on
> restructuring this?

Probably:

  (match tree
    (((heads . _) ...)
     (->bool (member top-directory heads))))

>>> +         (inodes-vhash   (alist->vhash
>>> +                          (map
>>> +                           (lambda (file)
>>> +                             (let ((stat
>>> +                                    (lstat (string-append directory "/" file))))
>>> +                               (cons (stat:ino stat) (stat:dev stat))))
>>> +                           files)))
>> 
>> I would call it ‘inodes’ simply.  Also, we could use ‘list->set’ from
>> (guix sets) here.
>
> I've made the inodes-vhash -> inodes rename, but I was undecided about
> using (guix sets), is there a reason you recommended it?

Because conceptually it’s a set: what we want to know is whether the set
contains a given inode/device pair.

I’ll comment on v2 of the patch.

Thank you,
Ludo’.

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Ludovic Courtès]

Hello,

Christopher Baines <mail@cbaines.net> skribis:

> +(define (create-directory-tree files)
> +  (define (directory-lists->tree directory-lists)
> +    (map (lambda (top-level-dir)
> +           (cons top-level-dir
> +                 (directory-lists->tree
> +                  (filter-map
> +                   (lambda (directory-list)
> +                     (if (eq? (length directory-list) 1)
> +                         #f
> +                         (cdr directory-list)))
> +                   ;; Find all the directory lists under this top-level-dir
> +                   (filter
> +                    (lambda (directory-list)
> +                      (equal? (car directory-list)
> +                              top-level-dir))
> +                    directory-lists)))))
> +         (delete-duplicates
> +          (map car directory-lists))))
> +
> +  (directory-lists->tree
> +   (filter-map (lambda (path)
> +                 (let ((split-path (string-split path #\/)))
> +                   ;; If this is a file in the top of the repository?
> +                   (if (eq? (length split-path) 1)
> +                       #f
> +                       ;; drop-right to remove the filename, as it's
> +                       ;; just the directory tree that's important
> +                       (drop-right (string-split path #\/) 1))))
> +               files)))
> +
> +(define (directory-in-tree? directory whole-tree)
> +  (define directory-list-in-tree?
> +    (match-lambda*
> +      (((top-directory . rest) tree)
> +       (if (null? rest)
> +           (list? (member top-directory (map car tree)))
> +           (and=> (find (match-lambda
> +                          ((subtree-top-directory . subtree)
> +                           (equal? subtree-top-directory
> +                                   top-directory)))
> +                        tree)
> +                  (match-lambda
> +                    ((subtree-top-directory . subtree)
> +                     (directory-list-in-tree? rest subtree))))))))
> +
> +  (directory-list-in-tree? (string-split directory #\/)
> +                           whole-tree))

I tried it to fully understand what was going on.  While playing with it
I came up with a variant that is slightly more concise and clearer (at
least to me ;-)):

--8<---------------cut here---------------start------------->8---
(define (files->directory-tree files)
  "Return a tree of vhashes representing the directory listed in FILES, a list
like '(\"a/b\" \"b/c/d\")."
  (fold (lambda (file result)
          (let loop ((file (string-split file #\/))
                     (result result))
            (match file
              ((_)
               result)
              ((directory children ...)
               (match (vhash-assoc directory result)
                 (#f
                  (vhash-cons directory (loop children vlist-null)
                              result))
                 ((_ . previous)
                  ;; XXX: 'vhash-delete' is O(n).
                  (vhash-cons directory (loop children previous)
                              (vhash-delete directory result)))))
              (()
               result))))
        vlist-null
        files))

(define (directory-in-tree? tree directory)
  "Return true if DIRECTORY, a string like \"a/b\", denotes a directory listed
in TREE."
  (let loop ((directory (string-split directory #\/))
             (tree       tree))
    (match directory
      (()
       #t)
      ((head . tail)
       (match (vhash-assoc head tree)
         ((_ . sub-tree) (loop tail sub-tree))
         (#f #f))))))
--8<---------------cut here---------------end--------------->8---

The tree is a tree of vhash, which should make lookup (i.e.,
‘directory-in-tree?’) slightly faster.  So it works like this:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (files->directory-tree '("a" "a/b" "a/b/x" "a/c" "b" "b/c"))
$17 = #<vhash 2802a40 2 pairs>
scheme@(guile-user)> (directory-in-tree? $17 "a/b")
$18 = #t
scheme@(guile-user)> (directory-in-tree? $17 "a")
$19 = #t
scheme@(guile-user)> (directory-in-tree? $17 "a/b/x")
$21 = #f
scheme@(guile-user)> (directory-in-tree? $17 "a/c")
$22 = #f
scheme@(guile-user)> (directory-in-tree? $17 "b")
$23 = #t
--8<---------------cut here---------------end--------------->8---

WDYT?  If you like it, take it and adjust as you see fit.  We’re doing
4-hand coding like whichever fancy methodology recommends.  ;-)

Ludo’.

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 5453 bytes --]

On Wed, 21 Jun 2017 23:44:26 +0200
ludo@gnu.org (Ludovic Courtès) wrote:

> Hello,
> 
> Christopher Baines <mail@cbaines.net> skribis:
> 
> > +(define (create-directory-tree files)
> > +  (define (directory-lists->tree directory-lists)
> > +    (map (lambda (top-level-dir)
> > +           (cons top-level-dir
> > +                 (directory-lists->tree
> > +                  (filter-map
> > +                   (lambda (directory-list)
> > +                     (if (eq? (length directory-list) 1)
> > +                         #f
> > +                         (cdr directory-list)))
> > +                   ;; Find all the directory lists under this
> > top-level-dir
> > +                   (filter
> > +                    (lambda (directory-list)
> > +                      (equal? (car directory-list)
> > +                              top-level-dir))
> > +                    directory-lists)))))
> > +         (delete-duplicates
> > +          (map car directory-lists))))
> > +
> > +  (directory-lists->tree
> > +   (filter-map (lambda (path)
> > +                 (let ((split-path (string-split path #\/)))
> > +                   ;; If this is a file in the top of the
> > repository?
> > +                   (if (eq? (length split-path) 1)
> > +                       #f
> > +                       ;; drop-right to remove the filename, as
> > it's
> > +                       ;; just the directory tree that's important
> > +                       (drop-right (string-split path #\/) 1))))
> > +               files)))
> > +
> > +(define (directory-in-tree? directory whole-tree)
> > +  (define directory-list-in-tree?
> > +    (match-lambda*
> > +      (((top-directory . rest) tree)
> > +       (if (null? rest)
> > +           (list? (member top-directory (map car tree)))
> > +           (and=> (find (match-lambda
> > +                          ((subtree-top-directory . subtree)
> > +                           (equal? subtree-top-directory
> > +                                   top-directory)))
> > +                        tree)
> > +                  (match-lambda
> > +                    ((subtree-top-directory . subtree)
> > +                     (directory-list-in-tree? rest subtree))))))))
> > +
> > +  (directory-list-in-tree? (string-split directory #\/)
> > +                           whole-tree))  
> 
> I tried it to fully understand what was going on.  While playing with
> it I came up with a variant that is slightly more concise and clearer
> (at least to me ;-)):
> 
> --8<---------------cut here---------------start------------->8---
> (define (files->directory-tree files)
>   "Return a tree of vhashes representing the directory listed in
> FILES, a list like '(\"a/b\" \"b/c/d\")."
>   (fold (lambda (file result)
>           (let loop ((file (string-split file #\/))
>                      (result result))
>             (match file
>               ((_)
>                result)
>               ((directory children ...)
>                (match (vhash-assoc directory result)
>                  (#f
>                   (vhash-cons directory (loop children vlist-null)
>                               result))
>                  ((_ . previous)
>                   ;; XXX: 'vhash-delete' is O(n).
>                   (vhash-cons directory (loop children previous)
>                               (vhash-delete directory result)))))
>               (()
>                result))))
>         vlist-null
>         files))
> 
> (define (directory-in-tree? tree directory)
>   "Return true if DIRECTORY, a string like \"a/b\", denotes a
> directory listed in TREE."
>   (let loop ((directory (string-split directory #\/))
>              (tree       tree))
>     (match directory
>       (()
>        #t)
>       ((head . tail)
>        (match (vhash-assoc head tree)
>          ((_ . sub-tree) (loop tail sub-tree))
>          (#f #f))))))
> --8<---------------cut here---------------end--------------->8---

Thanks for looking at this Ludo, and apologies for taking so long to
reply. These functions are definately more concise. 

> The tree is a tree of vhash, which should make lookup (i.e.,
> ‘directory-in-tree?’) slightly faster.  So it works like this:
> 
> --8<---------------cut here---------------start------------->8---
> scheme@(guile-user)> (files->directory-tree '("a" "a/b" "a/b/x" "a/c"
> "b" "b/c")) $17 = #<vhash 2802a40 2 pairs>
> scheme@(guile-user)> (directory-in-tree? $17 "a/b")
> $18 = #t
> scheme@(guile-user)> (directory-in-tree? $17 "a")
> $19 = #t
> scheme@(guile-user)> (directory-in-tree? $17 "a/b/x")
> $21 = #f
> scheme@(guile-user)> (directory-in-tree? $17 "a/c")
> $22 = #f
> scheme@(guile-user)> (directory-in-tree? $17 "b")
> $23 = #t
> --8<---------------cut here---------------end--------------->8---
> 
> WDYT?  If you like it, take it and adjust as you see fit.  We’re doing
> 4-hand coding like whichever fancy methodology recommends.  ;-)

I've had a little look at the performance, and I think this approach of
using a vhash might be slower, but not by much. The biggest difference
I saw for the guix repository was 0.008 seconds, and for smart-answers
was 0.6 seconds.

I'm happy to go ahead with either though, obviously these performance
differences don't matter compared to the current performance for large
repositories.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Ludovic Courtès]

Hi!

Christopher Baines <mail@cbaines.net> skribis:

> I've had a little look at the performance, and I think this approach of
> using a vhash might be slower, but not by much. The biggest difference
> I saw for the guix repository was 0.008 seconds, and for smart-answers
> was 0.6 seconds.
>
> I'm happy to go ahead with either though, obviously these performance
> differences don't matter compared to the current performance for large
> repositories.

I’ve finally pushed the patch with my changes as
f135b4ae8397d2c501150d3ead3e0603e770ce3f.

Seems to work well but let me know if you encounter any issues.

Thanks, and sorry for the delay!

Ludo’.

Re: [PATCH] git-download: Speed up 'git-predicate'.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 824 bytes --]

On Tue, 25 Jul 2017 23:26:15 +0200
ludo@gnu.org (Ludovic Courtès) wrote:

> Hi!
> 
> Christopher Baines <mail@cbaines.net> skribis:
> 
> > I've had a little look at the performance, and I think this
> > approach of using a vhash might be slower, but not by much. The
> > biggest difference I saw for the guix repository was 0.008 seconds,
> > and for smart-answers was 0.6 seconds.
> >
> > I'm happy to go ahead with either though, obviously these
> > performance differences don't matter compared to the current
> > performance for large repositories.  
> 
> I’ve finally pushed the patch with my changes as
> f135b4ae8397d2c501150d3ead3e0603e770ce3f.
> 
> Seems to work well but let me know if you encounter any issues.
> 
> Thanks, and sorry for the delay!

No problem, thanks for your help :)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]