[WhiteShark]

Уважаемые форумчане!
Как красиво решить следующую задачку?
Имеем два или более списков (пусть будет два для простоты) вида (Т nil T nil) и (1 2 3 4) к примеру. Надо их значения как бы перемножить, то есть получить в данном примере (1 3).
(Т nil T nil) * (1 2 3 4) -> (1 3)
Только коротко и талантливо через mapcar и apply, а не через foreach и lambda какие-нибудь.
Что-то не соображу после праздников сам никак.

[Дима_]

Код:

[Выделить все]

 (defun test(l1 l2)
  (mapcar 'cdr (vl-remove-if-not 'car (mapcar 'cons l1 l2))))

(test '(T nil nil T) '(1 2 3 4)) -> (1 4)

[Кулик Алексей aka kpblc]

Это как - перемножать логическое и числовое значения?

[WhiteShark]

Дима_ как всегда кроссавчик! Правда я сам уже почти доделал к этому моменту. Понимаю, что торопился и перепутал cdr и car местами и должно быть
(mapcar 'car (vl-remove-if-not 'cdr (mapcar 'cons l1 l2)))

а пардон, просто я у себя местами списки поменял. Получается зависимость от порядка аргументов. Не хорошо

Но всё равно спасибо!

----- добавлено через ~30 мин. -----
Распространил на случай нескольких списков и убрал зависимость от порядка. Криво конечно, но

Код:

[Выделить все]

 (setq lst1 '(nil 0 2 5)
      lst2 '(1 2 3 4)
      lst3 '(4 nil 6 7)
      )
(mapcar 'cdr (vl-remove-if-not 'car (mapcar 'list (mapcar 'and lst3 lst1 lst2 ) lst1 lst2 lst3 )))

[VVA]

Мой вариант

Код:

[Выделить все]

 
(setq l1 '(nil   0   2 5)
      l2 '(1     2   3 4)
      l3 '(4    nil  6 7)
      )
  (vl-remove-if-not '(lambda(x)(apply 'and x))(mapcar 'list l1 l2 l3))

_$ ((2 3 6) (5 4 7)) _$

----- добавлено через ~11 ч. -----
Еще вариант, если нужно оставить только числа

Код:

[Выделить все]

 
(setq l1 '(nil   0   2 5 "1")
      l2 '(1     2   3 4  2)
      l3 '(4    nil  6 7  3)
      )
  (vl-remove-if-not '(lambda(x)(apply 'and (mapcar 'numberp x)))(mapcar 'list l1 l2 l3))

_$ ((2 3 6) (5 4 7))

[WhiteShark]

Спасибо, что подключились, Владимир ) Но по условиям конкурса можно использовать только встроенные функции (не lambda)

[Кулик Алексей aka kpblc]

А чем lambda не нравится? Она тоже встроенная.
P.S. Тогда уж и от vl-remove-* надо отказываться

[Елпанов Евгений]

Сообщение от Кулик Алексей aka kpblc А чем lambda не нравится? Она тоже встроенная. P.S. Тогда уж и от vl-remove-* надо отказываться

Вариант через рекурсию:

Код:

[Выделить все]

 (defun F2 (L)
  (cond	((not(car L)) nil)
	((apply 'and (mapcar 'car L)) (cons (mapcar 'car L) (F2 (mapcar 'cdr L))))
	((F2 (mapcar 'cdr L)))
  )
)

тест:

Код:

[Выделить все]

 (f2 '((NIL 0 2 5)(1 2 3 4)(4 NIL 6 7)))

[Profan]

А как бы перемножить (null T) на (T nil)?

[WhiteShark]

To Алексей: просто такие условия) вот vl-remove функция родная, а лямбды (не сами по себе, а по содержанию) - уже пользовательские
To Profan: Очевидно у nil приоритет, так что ()
Уважаемый Евгений, приветствуем! Но как то у вас не коротко вышло

На самом деле задачка не из пальца высосана, а в оригинале выглядела как "фильтр" для списка вида

(("dimensions" "razmer" "размер" "размеры")
("text" "tekst" "надпис" "текст")
("leaders" "label" "vynosk" "vinosk" "выноски")
("tables" "tabli" "таблица" "таблицы"))

откуда надо выбрать только строку по одному ключевому слову. То есть, например, для "надпис" список должен отфильтроваться до
("text" "tekst" "надпис" "текст")

[Кулик Алексей aka kpblc]

Offtop: Про лямбды я как-то на autolisp.ru высказывался.
Вопрос номер раз: а как ты предполагаешь обрабатывать этот список?
А этот список как получен? Руками или все-таки как результат какой-то функции? Кто мешает его подсунуть в еще одну функцию?
P.S. И наверняка самое простое будет нечто типа
(vl-remove-if-not '(lambda(x) (member "надпис" x)) '(("dimensions" "razmer" "размер" "размеры")
("text" "tekst" "надпис" "текст")
("leaders" "label" "vynosk" "vinosk" "выноски")
("tables" "tabli" "таблица" "таблицы")))
Пишу насухую - кад сейчас не запустить, так что проверяй скобки и имена.

[WhiteShark]

Может ты и прав, Алексей, может и праав..

[Елпанов Евгений]

Сообщение от WhiteShark Уважаемый Евгений, приветствуем! Но как то у вас не коротко вышло

Ок, покажи короче, но с дополнительным условием - никаких VL*

[Дима_]

Можно я:

Код:

[Выделить все]

 (defun rt(l1 l2)
  (if l1 (if (car l1) (cons (car l2) (rt (cdr l1) (cdr l2)))
                      (rt (cdr l1) (cdr l2)))))

(rt '(T nil T nil T) '(1 2 3 4 5)) -> (1 3 5)

[Елпанов Евгений]

Сообщение от Дима_ Можно я: Код: [Выделить все] (defun rt(l1 l2) (if l1 (if (car l1) (cons (car l2) (rt (cdr l1) (cdr l2))) (rt (cdr l1) (cdr l2))))) (rt '(T nil T nil T) '(1 2 3 4 5)) -> (1 3 5)

отличный код для обработки двух списков, а у меня неограниченное количество списков и любое местоположения меток удаления...

----- добавлено через ~4 мин. -----
WhiteShark, поясни мне, а почему ты оказываешься от использования LAMBDA функций? Подобные ограничения ты даешь во многих своих темах...

[WhiteShark]

В общем рассказываю, Евгений ))

Где то я видел красивое решение по скажем так "инъектированию" функции. Что то типа вот этого когда Владимира Нестеровского по транспонированию матрицы

(defun trp ( m )
(apply 'mapcar (cons 'list m)))

Здесь функция list вставляется или "инъектируется" перед списками и далее пасуется вся комбинация mapcar'у. Вот, скажем, у меня какой лист

(setq lst '((1 2 3) (nil T nil)))

При если на него натравить вышенаписанную функцию, то первым промежуточным результатом - а именно выполнения конструкции (cons 'list m) будет (list (1 2 3) (nil T nil)). И далее apply mapcar...
Действуя аналогичным образом, я составил для моей исходной задачи такую функцию
(apply 'mapcar (list 'vl-remove-if-not 'cdr (apply 'mapcar (cons 'cons lst)))) где выделенная часть даёт
(vl-remove-if-not 'cdr ((1) (2 . T) (3)))

И вот было у меня впечатление, что в том красивом решении, которое я не мог вспомнить, как раз было как то сделано так, что и сложная функция - данном случае vl-remove-if-not 'cdr была передана дальше mapcar'у. То есть что то типа
(apply 'mapcar (list 'vl-remove-if-not 'cdr (apply 'mapcar (cons 'cons lst)))) -> (apply 'mapcar (vl-remove-if-not 'cdr ((1) (2 . T) (3))) ) таки можно сделать. Поэтому было поставлено условие решить задачу без lambda.

Но всё таки в том красивом решении по ходу дела была простая функция типа list, а не из двух компонентов типа vl-remove-if-not 'cdr.

А так то я против лямбды ничего не имею ))

[Дима_]

То Евгений - решил, ради спортивного интереса, подправить для обработки списка списков - получилась один в один как у Вас (только названия функции и списка другие и на строки по другому поделено) - забавно.
То WhiteShark Я не увидел причинно-следственной связи с вопросом Евгения в Вашем ответе.

[Елпанов Евгений]

может как нибудь так?

Код:

[Выделить все]

 (vl-remove nil (mapcar 'if (mapcar 'and lst1 lst2 lst3) (mapcar 'list lst1 lst2 lst3)))

----- добавлено через ~13 мин. -----
то же самое, но без VL*

Код:

[Выделить все]

(apply 'append (mapcar 'if (mapcar 'and lst1 lst2 lst3) (mapcar 'list (mapcar 'list lst1 lst2 lst3))))

----- добавлено через ~18 мин. -----

Сообщение от Дима_ То Евгений - решил, ради спортивного интереса, подправить для обработки списка списков - получилась один в один как у Вас (только названия функции и списка другие и на строки по другому поделено) - забавно. То WhiteShark Я не увидел причинно-следственной связи с вопросом Евгения в Вашем ответе.

Первоначально, для двух списков, я написал такой же код, как и у тебя...
Похоже у нас нехватка фантазии

[WhiteShark]

Вот ход с if это красиво и оригинально