emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* Faster version of org-find-olp
@ 2019-08-16 23:53 Adam Porter
  2019-08-17  0:10 ` Adam Porter
  2020-02-04  8:16 ` Bastien
  0 siblings, 2 replies; 6+ messages in thread
From: Adam Porter @ 2019-08-16 23:53 UTC (permalink / raw)
  To: emacs-orgmode

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

Hi,

While working on org-recent-headings, I thought I needed a version of
org-find-olp that behaved slightly differently, so I wrote a new
function.  It turned out that I didn't need the new function, but I
found that it seems to be much faster than org-find-olp, so it might be
worth using in Org.

Here is the code and test results.  The bench-multi-lexical macro is
from:

https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-macros

You'll note that it slightly differs in behavior in two ways:

1.  When an outline path is not found, it returns nil instead of raising
an error.  This could easily be changed to match the behavior of
org-find-olp, of course.  However, it makes the function easier to use
to check for the existence of an OLP without raising an error, and
AFAICT org-find-olp is only used in a few places, so it might be worth
considering to use this new behavior.

2.  Checking for duplicate OLPs is optional.  Sometimes it may be useful
to find an OLP regardless of whether a duplicate exists, and this allows
for that.

Provided are two versions of the function: the only difference between
them is that the *-named version uses:

  (format org-complex-heading-regexp-format ...)

...while the non-* version uses rx-to-string with an rx form.  The
rx-to-string version appears to be significantly faster.  I'm not sure
why.  Perhaps format is an expensive call--it's the only difference
between the two versions--but my cursory profiling didn't necessarily
indicate that was the source of the difference.

As far as finding duplicates, it seems to work properly in my testing.
But beware, I have only tested the code, not proven it correct.*  ;)

If this would be useful to have in Org, whether as a replacement for
org-find-olp or otherwise, I could submit a patch.

Thanks,
Adam

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-olp-marker code and benchmarks --]
[-- Type: text/x-org, Size: 5817 bytes --]

#+BEGIN_SRC elisp :results silent
  (defun org-olp-marker (olp &optional this-buffer unique)
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (rx-to-string `(seq bol (repeat ,level "*") (1+ blank)
                                                         (optional (1+ upper) (1+ blank)) ; To-do keyword
                                                         (optional "[#" (in "ABC") "]" (1+ blank)) ; Priority
                                                         ,(car headings) (0+ blank) (or eol ":")))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) (cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))

  (defun org-olp-marker* (olp &optional this-buffer unique)
    ;; NOTE: This version uses `org-complex-heading-regexp-format'.
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (format org-complex-heading-regexp-format (regexp-quote (car headings)))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) (cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))
#+END_SRC

#+BEGIN_SRC elisp
  (let* ((content "* Text before [[Test heading]] Text after 1

  blah blah
  ,** Text before [[Test heading]] Text after 2

  foo bar
  ,*** Text before [[Test heading]] Text after 3

  buzz

  ")
         (olp '("Text before [[Test heading]] Text after 1"
                "Text before [[Test heading]] Text after 2"
                "Text before [[Test heading]] Text after 3")))
    (with-temp-buffer
      (org-mode)
      (dotimes (_ 2000)
        (insert "* Heading 1
  text
  ,** Heading 2
  text
  ,*** Heading 3
  text
  "))
      (insert content)
      (bench-multi-lexical :times 500 :ensure-equal t
        :forms (("org-find-olp" (org-find-olp olp t))
                ("org-olp-marker" (org-olp-marker olp t t))
                ("org-olp-marker*" (org-olp-marker* olp t t))))))
#+END_SRC

#+RESULTS:
| Form            | x faster than next | Total runtime | # of GCs | Total GC runtime |
|-----------------+--------------------+---------------+----------+------------------|
| org-olp-marker  |               2.66 |      0.857414 |        0 |                0 |
| org-olp-marker* |               1.29 |      2.283076 |        0 |                0 |
| org-find-olp    |            slowest |      2.946619 |        0 |                0 |

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Faster version of org-find-olp
  2019-08-16 23:53 Faster version of org-find-olp Adam Porter
@ 2019-08-17  0:10 ` Adam Porter
  2020-02-04  8:16 ` Bastien
  1 sibling, 0 replies; 6+ messages in thread
From: Adam Porter @ 2019-08-17  0:10 UTC (permalink / raw)
  To: emacs-orgmode

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

I see that using an "inline" attachment was a bad idea.  At least, the
lists.gnu.org Web UI wraps the lines.  Here it is as an "attachment"
attachment, in case that helps.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Code and benchmark results --]
[-- Type: text/x-org, Size: 5817 bytes --]

#+BEGIN_SRC elisp :results silent
  (defun org-olp-marker (olp &optional this-buffer unique)
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (rx-to-string `(seq bol (repeat ,level "*") (1+ blank)
                                                         (optional (1+ upper) (1+ blank)) ; To-do keyword
                                                         (optional "[#" (in "ABC") "]" (1+ blank)) ; Priority
                                                         ,(car headings) (0+ blank) (or eol ":")))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) (cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))

  (defun org-olp-marker* (olp &optional this-buffer unique)
    ;; NOTE: This version uses `org-complex-heading-regexp-format'.
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (format org-complex-heading-regexp-format (regexp-quote (car headings)))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) (cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))
#+END_SRC

#+BEGIN_SRC elisp
  (let* ((content "* Text before [[Test heading]] Text after 1

  blah blah
  ,** Text before [[Test heading]] Text after 2

  foo bar
  ,*** Text before [[Test heading]] Text after 3

  buzz

  ")
         (olp '("Text before [[Test heading]] Text after 1"
                "Text before [[Test heading]] Text after 2"
                "Text before [[Test heading]] Text after 3")))
    (with-temp-buffer
      (org-mode)
      (dotimes (_ 2000)
        (insert "* Heading 1
  text
  ,** Heading 2
  text
  ,*** Heading 3
  text
  "))
      (insert content)
      (bench-multi-lexical :times 500 :ensure-equal t
        :forms (("org-find-olp" (org-find-olp olp t))
                ("org-olp-marker" (org-olp-marker olp t t))
                ("org-olp-marker*" (org-olp-marker* olp t t))))))
#+END_SRC

#+RESULTS:
| Form            | x faster than next | Total runtime | # of GCs | Total GC runtime |
|-----------------+--------------------+---------------+----------+------------------|
| org-olp-marker  |               2.66 |      0.857414 |        0 |                0 |
| org-olp-marker* |               1.29 |      2.283076 |        0 |                0 |
| org-find-olp    |            slowest |      2.946619 |        0 |                0 |

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Faster version of org-find-olp
  2019-08-16 23:53 Faster version of org-find-olp Adam Porter
  2019-08-17  0:10 ` Adam Porter
@ 2020-02-04  8:16 ` Bastien
  2020-02-04 17:54   ` Eric Abrahamsen
  1 sibling, 1 reply; 6+ messages in thread
From: Bastien @ 2020-02-04  8:16 UTC (permalink / raw)
  To: Adam Porter; +Cc: emacs-orgmode

Hi Adam,

Adam Porter <adam@alphapapa.net> writes:

> While working on org-recent-headings, I thought I needed a version of
> org-find-olp that behaved slightly differently, so I wrote a new
> function.

thanks for working on such improvements.  Is there something here we
can integrate in Org (master)?  If possible, let's just optimize the
current functions with no added constraints or features, then see if
new options and features can be useful.

Thanks!

-- 
 Bastien

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Faster version of org-find-olp
  2020-02-04  8:16 ` Bastien
@ 2020-02-04 17:54   ` Eric Abrahamsen
  2020-02-10  7:17     ` Bastien
  0 siblings, 1 reply; 6+ messages in thread
From: Eric Abrahamsen @ 2020-02-04 17:54 UTC (permalink / raw)
  To: Bastien; +Cc: Adam Porter, emacs-orgmode

Bastien <bzg@gnu.org> writes:

> Hi Adam,
>
> Adam Porter <adam@alphapapa.net> writes:
>
>> While working on org-recent-headings, I thought I needed a version of
>> org-find-olp that behaved slightly differently, so I wrote a new
>> function.
>
> thanks for working on such improvements.  Is there something here we
> can integrate in Org (master)?  If possible, let's just optimize the
> current functions with no added constraints or features, then see if
> new options and features can be useful.

I ended up writing a function on top of that that does find-or-create,
so you can go to a certain outline path, creating and inserting
(optionally in sorted order) the missing segments as you go. It was
fairly difficult to get right, so perhaps it will be of use to someone,
or appropriate for Worg or even Org proper:

https://github.com/girzel/timesheet.el/blob/master/timesheet.el#L250

Yrs,
Eric

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Faster version of org-find-olp
  2020-02-04 17:54   ` Eric Abrahamsen
@ 2020-02-10  7:17     ` Bastien
  2020-02-10 18:32       ` Eric Abrahamsen
  0 siblings, 1 reply; 6+ messages in thread
From: Bastien @ 2020-02-10  7:17 UTC (permalink / raw)
  To: Eric Abrahamsen; +Cc: Adam Porter, emacs-orgmode

Hi Eric,

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

> I ended up writing a function on top of that that does find-or-create,
> so you can go to a certain outline path, creating and inserting
> (optionally in sorted order) the missing segments as you go. It was
> fairly difficult to get right, so perhaps it will be of use to someone,
> or appropriate for Worg or even Org proper:
>
> https://github.com/girzel/timesheet.el/blob/master/timesheet.el#L250

thanks for this - don't hesitate to reference it somewhere on Worg if
you think that's useful.

If you think this should go to Org's core, please make a patch and
tell what's the difference with your patch and how to test it to make
sure we really understand the issue at stake.  I don't have any issue
with the current implementation of `org-find-olp' so I cannot really
know.

Thanks!

-- 
 Bastien

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Faster version of org-find-olp
  2020-02-10  7:17     ` Bastien
@ 2020-02-10 18:32       ` Eric Abrahamsen
  0 siblings, 0 replies; 6+ messages in thread
From: Eric Abrahamsen @ 2020-02-10 18:32 UTC (permalink / raw)
  To: Bastien; +Cc: Adam Porter, emacs-orgmode

Bastien <bzg@gnu.org> writes:

> Hi Eric,
>
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> I ended up writing a function on top of that that does find-or-create,
>> so you can go to a certain outline path, creating and inserting
>> (optionally in sorted order) the missing segments as you go. It was
>> fairly difficult to get right, so perhaps it will be of use to someone,
>> or appropriate for Worg or even Org proper:
>>
>> https://github.com/girzel/timesheet.el/blob/master/timesheet.el#L250
>
> thanks for this - don't hesitate to reference it somewhere on Worg if
> you think that's useful.
>
> If you think this should go to Org's core, please make a patch and
> tell what's the difference with your patch and how to test it to make
> sure we really understand the issue at stake.  I don't have any issue
> with the current implementation of `org-find-olp' so I cannot really
> know.

It isn't a replacement for `org-find-olp'! It's just built on top of it.
`org-find-olp' signals an error if the full path isn't found. My
function looks for that error and creates the missing segments of the
path. If `org-find-olp' is the equivalent of "cd" in the shell, this
function is like "mkdir -p", plus the "cd" afterwards. It's nice for
programmatically creating outline structures (ie can be used to create
date trees and the like).

I guess I think worg is sufficient -- it's a nice utility, but perhaps
not necessary for core.

Eric

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2020-02-10 18:32 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-08-16 23:53 Faster version of org-find-olp Adam Porter
2019-08-17  0:10 ` Adam Porter
2020-02-04  8:16 ` Bastien
2020-02-04 17:54   ` Eric Abrahamsen
2020-02-10  7:17     ` Bastien
2020-02-10 18:32       ` Eric Abrahamsen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).