fork download
copy 
  1. (defun find-minimum-window-substring-pointers (string search)
  2.   (declare (type simple-string string)
  3.            (type simple-string search)
  4.            (optimize (speed 3) (safety 0) (debug 0)))
  5.   (let ((required (length (remove-duplicates search)))
  6.         (formed 0))
  7.     (cond ((<= required 1)
  8.            (let ((min-start (search search string)))
  9.              (cons min-start (+ min-start required))))
  10.           (t
  11.            (let* ((search-count
  12.                     (loop with counter = (make-array 256
  13.                                                      :element-type 'fixnum
  14.                                                      :initial-element 0)
  15.                           for c across (the simple-string search)
  16.                           for i = (char-code c)
  17.                           do (incf (aref counter i))
  18.                           finally (return counter)))
  19.                   (window-count (make-array 256 :element-type 'fixnum
  20.                                                 :initial-element 0))
  21.                   (string-len (length string))
  22.                   (min-len (1+ string-len))
  23.                   (min-start 0)
  24.                   (window-start 0))
  25.              ;; ウィンドウを右側へ広げながら走査する。
  26.              (dotimes (window-end string-len)
  27.                (let ((i (char-code (char string window-end))))
  28.                  ;; カウンターを更新。
  29.                  (incf (aref window-count i))
  30.                  (when (and (> (aref search-count i) 0)
  31.                             (= (aref window-count i) 1))
  32.                    (incf (the fixnum formed)))
  33.                  ;; 検索文字がすべてウィンドウ内に揃ったらウィンドウの
  34.                  ;; 左端を縮める。
  35.                  (loop while (= formed required)
  36.                        for i fixnum = (char-code (char string window-start))
  37.                        do ;; 現在のウィンドウが条件を満たす最短部分列
  38.                           ;; ならばそれを記録。
  39.                           (when (< (1+ (- window-end window-start)) min-len)
  40.                             (setq min-len (1+ (- window-end window-start))
  41.                                   min-start window-start))
  42.                           ;; カウンターを更新。
  43.                           (decf (aref window-count i))
  44.                           (when (and (> (aref search-count i) 0)
  45.                                      (= (aref window-count i) 0))
  46.                             (decf formed))
  47.                           (incf window-start))))
  48.              (if (= min-len (1+ string-len))
  49.                  (cons nil nil)
  50.                  (cons min-start (+ min-start min-len))))))))
  51.  
  52. (defun find-minimum-window-substring (string search)
  53.   (declare (type simple-string string)
  54.            (type simple-string search)
  55.            (optimize (speed 3) (safety 0) (debug 0)))
  56.   (destructuring-bind (start . end)
  57.       (find-minimum-window-substring-pointers string search)
  58.     (if (null start)
  59.         (values nil (cons nil nil))
  60.         (values (subseq string start end) (cons start end)))))
  61.  
  62.  
  63. (defun string-repeat (string n)
  64.   (format nil "~v@{~A~:*~}" n string))
  65.  
  66. (defmacro real-time (n-times &body form)
  67.   `(let ((start-time (get-internal-real-time))
  68.          (values nil))
  69.      (loop repeat ,n-times
  70.            do (setq values (multiple-value-list (progn ,@form))))
  71.      (let ((elapsed-time (- (get-internal-real-time) start-time)))
  72.        (values (/ elapsed-time internal-time-units-per-second)
  73.                values))))
  74.  
  75. (defun omit-long-string (string max-length &optional (min-length 0))
  76.   (let ((max-length (max max-length min-length)))
  77.     (let* ((omitted "...")
  78.            (prefix-len (- (floor max-length 2)
  79.                           (floor (length omitted) 2)))
  80.            (suffix-len (- (ceiling max-length 2)
  81.                           (ceiling (length omitted) 2))))
  82.       (if (<= (length string) max-length)
  83.           string
  84.           (format nil "~A~A~A"
  85.                   (subseq string 0 (min prefix-len (length string)))
  86.                   omitted
  87.                   (subseq string (- (length string)
  88.                                     (min suffix-len (length string)))))))))
  89.  
  90.  
  91. (defun make-test-case-524 ()
  92.   (let ((search "ruby"))
  93.     (list (with-output-to-string (*standard-output*)
  94.             (loop for i below (length search) do
  95.               (loop for c across "abcdefghijklmnopqrstuvwxyz"
  96.                     do (loop for d across "abcdefghijklmnopqrstuvwxyz"
  97.                              do (princ c)
  98.                                 (princ d)))))
  99.           search "rbsbtbubvbwbxby" 87)))
  100.  
  101. (defun make-test-case-549 ()
  102.   (let ((search "TheRubyProgrammingLanguage"))
  103.     (list (with-output-to-string (*standard-output*)
  104.             (dotimes (x 4)
  105.               (loop for i across "abcdefghijklmnopqrstuvwxyz"
  106.                     do (loop for j across "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  107.                              do (princ i)
  108.                                 (princ j))
  109.                        (loop for j across "abcdefghijklmnopqrstuvwxyz"
  110.                              do (princ i)
  111.                                 (princ j)))))
  112.           search
  113.           (concatenate 'string
  114.                        "LyMyNyOyPyQyRySyTyUyVyWyXyYyZyaybycydyeyfygyh"
  115.                        "yiyjykylymynyoypyqyrysytyu")
  116.           2519)))
  117.  
  118. (defparameter *n-times* 2000)
  119. (defparameter *test-cases*
  120.   ;; (string search expected-substring expected-position)
  121.   `(("DHBICEJAFG" "EIC" "ICE" 3)
  122.     ("FDGJHCBIEA" "EIC" "CBIE" 5)
  123.     ("FBHDCIJGEA" "EIC" "CIJGE" 4)
  124.     ("JDIBGHCEAF" "EIC" "IBGHCE" 2)
  125.     ("JBCIAGDHEF" "EIC" "CIAGDHE" 2)
  126.     ("EJFBCAGIHD" "EIC" "EJFBCAGI" 0)
  127.     ("IADCGJFBEH" "EIC" "IADCGJFBE" 0)
  128.     ("IDFHBJGAEC" "EIC" "IDFHBJGAEC" 0)
  129.     (,@(make-test-case-524))
  130.     (,@(make-test-case-549))))
  131.  
  132.  
  133. (loop initially
  134.         (format t  "TEST \"STRING\" \"SEARCH\" → \"SUBSTR\" POS~72TTIME~%")
  135.         (write-line (string-repeat "=" 78))
  136.       for (string search expected expected-pos) in *test-cases*
  137.       do (destructuring-bind (time (substring (substr-start . substr-end)))
  138.              (multiple-value-list (real-time *n-times*
  139.                                     (find-minimum-window-substring string
  140.                                                                    search)))
  141.            (declare (ignore substr-end))
  142.            (format t "~:[❌~;✓~] ~S ~S → ~S ~D~71T~,3F~%"
  143.                    (and (equal substring expected)
  144.                         (eql substr-start expected-pos))
  145.                    (omit-long-string string 18)
  146.                    (omit-long-string search 18)
  147.                    (omit-long-string substring 16)
  148.                    substr-start
  149.                    time)))
  150.  
Success #stdin #stdout 0.39s 34704KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
TEST "STRING" "SEARCH" → "SUBSTR" POS                                   TIME
==============================================================================
✓ "DHBICEJAFG" "EIC" → "ICE" 3                                         0.003
✓ "FDGJHCBIEA" "EIC" → "CBIE" 5                                        0.002
✓ "FBHDCIJGEA" "EIC" → "CIJGE" 4                                       0.002
✓ "JDIBGHCEAF" "EIC" → "IBGHCE" 2                                      0.002
✓ "JBCIAGDHEF" "EIC" → "CIAGDHE" 2                                     0.002
✓ "EJFBCAGIHD" "EIC" → "EJFBCAGI" 0                                    0.002
✓ "IADCGJFBEH" "EIC" → "IADCGJFBE" 0                                   0.002
✓ "IDFHBJGAEC" "EIC" → "IDFHBJGAEC" 0                                  0.002
✓ "aaabacad...wzxzyzz" "ruby" → "rbsbtbubvbwbxby" 87                   0.105
✓ "aAaBaCaD...wzxzyzz" "TheRubyP...anguage" → "LyMyNyO...ysytyu" 2519  0.261
https://ideone.com/qm4PsV
language:
Common Lisp (sbcl 1.4.16)
created:
11 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!