EDSL для FSM
В диком интернете нет (и не может быть) никакого порядка, в именовании файлов изображений. Это хорошо ещё, если картинку на хостинг закачивает вебмастер своими руками по фтп: в большинстве случаев имя файла будет относительно осмысленным, а вот если это происходит через веб-форму для аплоада, то имя, которое в итоге получит файл, остаётся на целиком совести скрипта.
На самом деле, можно ли вообще что-то извлечь из имени картинки? Как показывает практика, часто можно хотя бы попытаться:
clip_image001.jpg
52Untitled1_-_Copy.jpg
main-full.png
Copy%20(2)%20of%20IMG_4743.JPG
OceansTwelvePoster.jpg
2494cd87-dTulips.jpg
Small201191981250_Tulips.jpg
toyota_corolla_altis_2.0.jpg
Corolla20Altis202010.png
drawing-last-kiss-icey-cassvn-1024x768.jpg
PHOTOofME44.jpg
В принципе, уже по примерам видно, что можно попробовать чуток почистить текст и побить его на токены на стыках перепада капитализации, пунктуационных символов и циферок.
Вообще, на сишечке я в таких случаях всегда тупо пишу руками КА, даже если он код в итоге получается write-only и на три экрана. Как показывает практика, это всё равно в итоге оказывается быстрее, чем вымучивать всякие регекспы, парсеры с токенайзерами и тд., не говоря уж о том, что производительность получаю нахаляву.
Собственно, я попробовал было повторить этот трюк на CL, но где-то уже на четверти пути взвыл от бессилия: код выходит настолько паскудный (до горизонтального скролла), что даже смотреть на него омерзительно. Поэтому пришлось писать кодогенератор, даже для такой, вроде бы разовой задачи.
В целом, тут как бы всё несложно. У нас получаются всего четыре интересующих нас типа символов: невалидный, заглавная буква, строчная буква и цифра. И состояний тоже немного: выделяемые токены могут оказаться цифрами, словами полностью из строчных или заглавных букв, и словами с капитализированной первой буквой.
Идею, как обычно, буду иллюстрировать задом наперёд. Сначала собственно, как я изобразил правила генератора КА в eDSL: это просто список паттернов единственного типа, парсящихся по шаблону (<текущее состояние> <тип рассматриваемого символа> <новое состояние для перехода> &rest <действия>).
(defun detect-words (filename)
(let* ((state :miss)
(decoded-filename (url-decode filename))
(filename-w/o-extension-length (detect-extension-offset decoded-filename)))
(string-trim
'(#\Space)
(with-output-to-string (out-filename)
(iter (for idx from 0 below filename-w/o-extension-length)
(for char = (elt decoded-filename idx))
(with-parser-fsm (state char out-filename)
(:miss :upper :titlecase-head :pass)
(:miss :lower :lowercase :pass)
(:miss :digit :digit :pass)
(:miss :inval :miss :skip)
(:titlecase-head :upper :uppercase :pass)
(:titlecase-head :lower :titlecase-tail :pass)
(:titlecase-head :digit :digit :blank :pass)
(:titlecase-head :inval :miss :blank)
(:titlecase-tail :upper :titlecase-head :blank :pass)
(:titlecase-tail :lower :titlecase-tail :pass)
(:titlecase-tail :digit :digit :blank :pass)
(:titlecase-tail :inval :miss :blank)
(:uppercase :upper :uppercase :pass)
(:uppercase :lower :lowercase :blank :pass)
(:uppercase :digit :digit :blank :pass)
(:uppercase :inval :miss :blank)
(:lowercase :upper :titlecase-head :blank :pass)
(:lowercase :lower :lowercase :pass)
(:lowercase :digit :digit :blank :pass)
(:lowercase :inval :miss :blank)
(:digit :upper :titlecase-head :blank :pass)
(:digit :lower :lowercase :blank :pass)
(:digit :digit :digit :pass)
(:digit :inval :miss :blank)))))))
Ну и отсюда сразу понятно, что правила должны раскрыться в простыню cond:
(defmacro with-parser-fsm ((state char out-stream) &rest transitions)
`(cond
,@(iter (for (state-case char-case new-state . actions) in transitions)
(for char-test = (ecase char-case
(:upper `((and (alpha-char-p ,char) (upper-case-p ,char))))
(:lower `((and (alpha-char-p ,char) (lower-case-p ,char))))
(:digit `((digit-char-p ,char)))
(:inval nil)))
(collect `((and (eq ,state ,state-case) ,@char-test)
(setf ,state ,new-state)
,@(iter (for action in actions)
(ecase action
(:pass (collect `(write-char (char-downcase ,char) ,out-stream)))
(:blank (collect `(write-char #\Space ,out-stream)))
(:skip nil))))))
(t (error "Unexpected state in fsm"))))
На самом деле, тут ещё довольно свободно можно усовершенствовать генератор, чтобы он собирал последовательные условия в деревья и заинлайнил проверки типа alpha-char-p, но для одноразовой задачи мне это было лень.
FILENAME-DECODER> (mapcar #'detect-words *examples*)
("clip image 001" "52 untitled 1 copy" "main full" "copy 2 of img 4743"
"oceans twelve poster" "2494 cd 87 d tulips" "small 201191981250 tulips"
"toyota corolla altis 2 0" "corolla 20 altis 202010"
"drawing last kiss icey cassvn 1024 x 768" "photo of me 44")
По-моему, вполне неплохой результат для бессловарного метода.
На самом деле, можно ли вообще что-то извлечь из имени картинки? Как показывает практика, часто можно хотя бы попытаться:
clip_image001.jpg
52Untitled1_-_Copy.jpg
main-full.png
Copy%20(2)%20of%20IMG_4743.JPG
OceansTwelvePoster.jpg
2494cd87-dTulips.jpg
Small201191981250_Tulips.jpg
toyota_corolla_altis_2.0.jpg
Corolla20Altis202010.png
drawing-last-kiss-icey-cassvn-1024x768.jpg
PHOTOofME44.jpg
В принципе, уже по примерам видно, что можно попробовать чуток почистить текст и побить его на токены на стыках перепада капитализации, пунктуационных символов и циферок.
Вообще, на сишечке я в таких случаях всегда тупо пишу руками КА, даже если он код в итоге получается write-only и на три экрана. Как показывает практика, это всё равно в итоге оказывается быстрее, чем вымучивать всякие регекспы, парсеры с токенайзерами и тд., не говоря уж о том, что производительность получаю нахаляву.
Собственно, я попробовал было повторить этот трюк на CL, но где-то уже на четверти пути взвыл от бессилия: код выходит настолько паскудный (до горизонтального скролла), что даже смотреть на него омерзительно. Поэтому пришлось писать кодогенератор, даже для такой, вроде бы разовой задачи.
В целом, тут как бы всё несложно. У нас получаются всего четыре интересующих нас типа символов: невалидный, заглавная буква, строчная буква и цифра. И состояний тоже немного: выделяемые токены могут оказаться цифрами, словами полностью из строчных или заглавных букв, и словами с капитализированной первой буквой.
Идею, как обычно, буду иллюстрировать задом наперёд. Сначала собственно, как я изобразил правила генератора КА в eDSL: это просто список паттернов единственного типа, парсящихся по шаблону (<текущее состояние> <тип рассматриваемого символа> <новое состояние для перехода> &rest <действия>).
(defun detect-words (filename)
(let* ((state :miss)
(decoded-filename (url-decode filename))
(filename-w/o-extension-length (detect-extension-offset decoded-filename)))
(string-trim
'(#\Space)
(with-output-to-string (out-filename)
(iter (for idx from 0 below filename-w/o-extension-length)
(for char = (elt decoded-filename idx))
(with-parser-fsm (state char out-filename)
(:miss :upper :titlecase-head :pass)
(:miss :lower :lowercase :pass)
(:miss :digit :digit :pass)
(:miss :inval :miss :skip)
(:titlecase-head :upper :uppercase :pass)
(:titlecase-head :lower :titlecase-tail :pass)
(:titlecase-head :digit :digit :blank :pass)
(:titlecase-head :inval :miss :blank)
(:titlecase-tail :upper :titlecase-head :blank :pass)
(:titlecase-tail :lower :titlecase-tail :pass)
(:titlecase-tail :digit :digit :blank :pass)
(:titlecase-tail :inval :miss :blank)
(:uppercase :upper :uppercase :pass)
(:uppercase :lower :lowercase :blank :pass)
(:uppercase :digit :digit :blank :pass)
(:uppercase :inval :miss :blank)
(:lowercase :upper :titlecase-head :blank :pass)
(:lowercase :lower :lowercase :pass)
(:lowercase :digit :digit :blank :pass)
(:lowercase :inval :miss :blank)
(:digit :upper :titlecase-head :blank :pass)
(:digit :lower :lowercase :blank :pass)
(:digit :digit :digit :pass)
(:digit :inval :miss :blank)))))))
Ну и отсюда сразу понятно, что правила должны раскрыться в простыню cond:
(defmacro with-parser-fsm ((state char out-stream) &rest transitions)
`(cond
,@(iter (for (state-case char-case new-state . actions) in transitions)
(for char-test = (ecase char-case
(:upper `((and (alpha-char-p ,char) (upper-case-p ,char))))
(:lower `((and (alpha-char-p ,char) (lower-case-p ,char))))
(:digit `((digit-char-p ,char)))
(:inval nil)))
(collect `((and (eq ,state ,state-case) ,@char-test)
(setf ,state ,new-state)
,@(iter (for action in actions)
(ecase action
(:pass (collect `(write-char (char-downcase ,char) ,out-stream)))
(:blank (collect `(write-char #\Space ,out-stream)))
(:skip nil))))))
(t (error "Unexpected state in fsm"))))
На самом деле, тут ещё довольно свободно можно усовершенствовать генератор, чтобы он собирал последовательные условия в деревья и заинлайнил проверки типа alpha-char-p, но для одноразовой задачи мне это было лень.
FILENAME-DECODER> (mapcar #'detect-words *examples*)
("clip image 001" "52 untitled 1 copy" "main full" "copy 2 of img 4743"
"oceans twelve poster" "2494 cd 87 d tulips" "small 201191981250 tulips"
"toyota corolla altis 2 0" "corolla 20 altis 202010"
"drawing last kiss icey cassvn 1024 x 768" "photo of me 44")
По-моему, вполне неплохой результат для бессловарного метода.