Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > LISP > Архивация строки

Автор: Metalex 1.12.2012, 15:19

Здравствуйте!
Решаю задачки, но застрял на одной, подтолкните в правильном направлении, пожалуйста.
Условие:
Есть строка, в ней надо заменить подстроки, которые состоят из 4х и больше одинаковых символов (идущих подряд) на знак ! + количество подряд идущих одинаковых символов + сам символ.

Например:

aabbaaabbbcsdkAAAAbbbbb => aabbaaabbbcsdk!4A!5b

Ничего лучше, чем просто в do или loop идти по строке и искать вхождения одинаковых символов в голову не приходит..
Также не понятно как заменить подстроку. Нашел http://emacswiki.org/emacs/ReplaceInString, но мой emacs 21 не знаком с функцией replace-regexp-in-string.

Спасибо за любые советы.

Автор: _sg 2.12.2012, 11:18

Код


(defun ar (n ac)
  (concatenate 'string "!" (write-to-string n) (car ac)))

(defun chive (w &optional ac acc (n 0) &aux (a (car w)) (d (cdr w)))
  (cond ((null w) (reverse (if (> n 3) (cons (ar n ac) acc) (nconc ac acc))))
        ((equal a (car ac)) (chive d (cons a ac) acc (+ n 1)))
        ((> n 3) (chive d (list a) (cons (ar n ac) acc) 1))
        ((chive d (list a) (nconc ac acc) 1))))

(defun archive (s)
  (apply #'concatenate 'string (chive (map 'list #'string s))))

> (archive "aabbaaabbbcsdkAAAAbbbbb")
"aabbaaabbbcsdk!4A!5b"

Автор: Metalex 2.12.2012, 13:40

_sg, огромное спасибо! Не ожидал, что так запутано выйдет, буду разбираться!

Автор: Metalex 2.12.2012, 15:31

_sg, можете, пожалуйста, пояснить, что происходит здесь:

Код


(defun archive (s)
  (apply #'concatenate 'string (chive (map 'list #'string s))))

а также что означает #?

Спасибо.

EDIT:
разобрался со всем кроме apply и #

Автор: _sg 2.12.2012, 16:50

Функция apply применяет функцию к одному и более аргументу, последним из которых должен быть список:

Код


> (apply #'* '(8 9 10))        
720

> (apply #'* 8 9 '(10))
720

> (apply #'min '(7 4 6 4 5))
4

> (apply #'max '(7 4 6 4 5))
7

#' - сокращенная запись function - вызов функции, т.е. #'f эквивалентно (function f), например:

Код


CL-USER> (concatenate 'string "a" "b" "c")
"abc"
CL-USER> (apply #'concatenate 'string '("a" "b" "c"))
"abc"

подробнее (с примерами):
www.lispworks.com/documentation/HyperSpec/Body/f_apply.htm
www.lispworks.com/documentation/HyperSpec/Body/02_dhb.htm

Автор: k0rvin 3.12.2012, 12:45

Можно еще так:

Код


(defparameter *archive-string-count* 4)

(defun write-or-archive (stream char count)
  (when (>  count 0)
    (if (>= count *archive-string-count*)
        (format stream "!~a~a" count char)
        (format stream (make-string count :initial-element char)))))

(defun archive (string)
  (let ((char  #\Null)
        (count 0  ))
    (with-output-to-string (s)
      (loop :for c :across string
            :if (char= c char) :do
              (incf count)
            :else :do
              (write-or-archive s char count)
              (setf char  c)
              (setf count 1)
            :finally (write-or-archive s char count)))))

Автор: Catstail 8.2.2013, 10:29

Вот чисто императивное решение для HomeLisp:

Код



(defun str-press (stri)
  (let ((count 0) (curr "") (prev (strMid stri 1 1)) (res ""))
    (dotimes (j (strLen (strCat (strMid stri 2) (strChr 0))) res)
       (setq curr (strMid stri (+ j 2) 1))
       (if (eq curr prev) 
           (setq count (add1 count))
           (cond ((>= count 4) 
                  (progn  (setq res (strCat res "!" (fix2str (add1 count)) prev))
                          (setq count 0)))
                 ((> count 0) 
                  (progn  (dotimes (i (add1 count) t) (setq res (strCat res prev)))
                          (setq count 0)))
                 (t (setq res (strCat res prev)))))
       (setq prev curr))))    

==> str-press

(str-press "11111qqWWWWW678xxxxxxxxs")

==> "!51qq!5W678!8xs"

(str-press "11111qqWWWWW678xxxxxxxx")

==> "!51qq!5W678!8x"

Автор: Catstail 8.2.2013, 11:08

Вот еще одно решение (тоже для HomeLisp):

Код


(defun act-1 (lst &optional res prev (count 0))
  (cond ((null lst) (cond ((> count 0) (append res (list (list (add1 count) prev))))
                          (t (append res (list prev)))))
        ((EQ (car lst) prev) (act-1 (cdr lst) res prev (add1 count)))
        (t (cond ((> count 0) (act-1 (cdr lst) (append res (list (list (add1 count) prev))) (car lst) 0))
                 (t (act-1 (cdr lst) (if (null prev) res (append res (list prev))) (car lst) 0))))))  

==> act-1

 (defun act-2 (lst)
   (let ((res nil))
     (iter (for i in lst)
        (when (and (listp i) (>= (car i) 4)) 
              (collecting '! into res) (collecting (car i) into res) (collecting (cadr i) into res))
        (when (and (listp i) (< (car i) 4)) 
              (dotimes (j (car i) t) (collecting (cadr i) into res)))
        (when (atom i) (collecting i into res))) res ))

==> act-2

(defun str-press (stri)
  (implode (act-2 (act-1 (explode stri)))))

==> str-press

(str-press "dddfffffh5555555")

==> "ddd!5fh!75"

(str-press "dddfffffh5555555a")

==> "ddd!5fh!75a"