VPF::Архивация строки - Форум программистов

Metalex

Дата 1.12.2012, 15:19 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

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

Например:

aabbaaabbbcsdkAAAAbbbbb => aabbaaabbbcsdk!4A!5b

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

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

--------------------

Don't let the system get you down.

_sg

Дата 2.12.2012, 11:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 119
Регистрация: 16.5.2007

Репутация: 2
Всего: 2

Код


(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"

Это сообщение отредактировал(а) _sg - 2.12.2012, 11:27

--------------------

vk.com/ansicommonlisp

Metalex

Дата 2.12.2012, 13:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

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

--------------------

Don't let the system get you down.

Metalex

Дата 2.12.2012, 15:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

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

Код


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

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

Спасибо.

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

Это сообщение отредактировал(а) Metalex - 2.12.2012, 16:39

--------------------

Don't let the system get you down.

_sg

Дата 2.12.2012, 16:50 (ссылка)

(голосов:1)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 119
Регистрация: 16.5.2007

Репутация: 2
Всего: 2

Функция 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

Это сообщение отредактировал(а) _sg - 2.12.2012, 23:38

--------------------

vk.com/ansicommonlisp

k0rvin

Дата 3.12.2012, 12:45 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 442
Регистрация: 24.1.2010

Репутация: нет
Всего: 5

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

Код


(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)))))

--------------------

“Object-oriented design is the roman numerals of computing.” — Rob Pike
All software sucks

Catstail

Дата 8.2.2013, 10:29 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 14.1.2013

Репутация: нет
Всего: нет

Вот чисто императивное решение для 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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 14.1.2013

Репутация: нет
Всего: нет

Вот еще одно решение (тоже для 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"

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| LISP \| Следующая тема »