Nhiệm vụ khai thác Lisp


19

Trong các ngôn ngữ kiểu Lisp, một danh sách thường được định nghĩa như sau:

(list 1 2 3)

Đối với mục đích của thử thách này, tất cả các danh sách sẽ chỉ chứa các số nguyên dương hoặc các danh sách khác. Chúng tôi cũng sẽ bỏ listtừ khóa khi bắt đầu, vì vậy danh sách bây giờ sẽ như thế này:

(1 2 3)

Chúng ta có thể lấy phần tử đầu tiên của danh sách bằng cách sử dụng car. Ví dụ:

(car (1 2 3))
==> 1

Và chúng ta có thể lấy danh sách gốc với phần tử đầu tiên được xóa bằng cdr:

(cdr (1 2 3))
==> (2 3)

Quan trọng: cdrsẽ luôn trả về một danh sách, ngay cả khi danh sách đó có một yếu tố duy nhất:

(cdr (1 2))
==> (2)
(car (cdr (1 2)))
==> 2

Danh sách cũng có thể nằm trong danh sách khác:

(cdr (1 2 3 (4 5 6)))
==> (2 3 (4 5 6))

Viết chương trình trả về mã sử dụng carcdrtrả về một số nguyên nhất định trong danh sách. Trong mã mà chương trình của bạn trả về, bạn có thể giả sử rằng danh sách được lưu trữ l, số nguyên đích nằm ở lđâu đó và tất cả các số nguyên là duy nhất.

Ví dụ:

Đầu vào: (6 1 3) 3

Đầu ra: (car (cdr (cdr l)))

Đầu vào: (4 5 (1 2 (7) 9 (10 8 14))) 8

Đầu ra: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Đầu vào: (1 12 1992) 1

Đầu ra: (car l)


Chúng ta có thể lấy đầu vào với số nguyên đầu tiên và danh sách thứ hai không?
Martin Ender

@ MartinBüttner Chắc chắn.
absinthe

Thế còn (1 2 3) 16chúng ta sẽ trở về ()?
coredump

@coredump Câu hỏi hay. Bạn có thể giả sử rằng số nguyên đích sẽ luôn ở trong biểu thức, vì vậy một trường hợp như thế (1 2 3) 16sẽ không bao giờ xuất hiện.
absinthe

Chúng ta có thể nhận hai đầu vào, một cho danh sách và một cho số nguyên không?
Hố đen

Câu trả lời:


1

CJam, 59

q"()""[]"er~{:AL>{0jA1<e_-_A(?j'l/"(car l)"@{2'dt}&*}"l"?}j

Dùng thử trực tuyến

Giải trình:

q                 read the input
"()""[]"er        replace parentheses with square brackets
~                 evaluate the string, pushing an array and a number
{…}j              calculate with memoized recursion using the array as the argument
                   and the number as the memozied value for argument 0
  :A              store the argument in A
  L>              practically, check if A is an array
                   if A is a (non-empty) array, compare with an empty array
                   (result 1, true)
                   if A is a number, slice the empty array from that position
                   (result [], false)
    {…}           if A is an array
      0j          get the memoized value for 0 (the number to search)
      A1<         slice A keeping only its first element
      e_          flatten array
      -           set difference - true iff the number was not in the array
      _           duplicate the result (this is the car/cdr indicator)
      A(          uncons A from left, resulting in the "cdr" followed by the "car"
      ?           choose the cdr if the number was not in the flattened first item,
                   else choose the car
      j           call the block recursively with the chosen value as the argument
      'l/         split the result around the 'l' character
      "(car l)"   push this string
      @           bring up the car/cdr indicator
      {…}&        if true (indicating cdr)
        2'dt      set the character in position 2 to 'd'
      *           join the split pieces using the resulting string as a separator
    "l"           else (if A is not an array) just push "l"
                   (we know that when we get to a number, it is the right number)
    ?             end if

10

Lisp thường gặp, 99

Giải pháp 99 byte sau đây là phiên bản CL của câu trả lời Scheme đẹp .

(defun g(l n &optional(o'l))(if(eql n l)o(and(consp l)(or(g(car l)n`(car,o))(g(cdr l)n`(cdr,o))))))

Ban đầu tôi đã cố gắng sử dụng positionposition-if, nhưng hóa ra nó không nhỏ gọn như tôi muốn (209 byte):

(lambda(L x &aux(p'l))(labels((f(S &aux e)(cons(or(position x S)(position-if(lambda(y)(if(consp y)(setf e(f y))))S)(return-from f()))e)))(dolist(o(print(f L))p)(dotimes(i o)(setf p`(cdr,p)))(setf p`(car,p)))))

Mở rộng

(lambda
  (l x &aux (p 'l))
  (labels ((f (s &aux e)
             (cons
              (or (position x s)
                  (position-if
                   (lambda (y)
                     (if (consp y)
                         (setf e (f y))))
                   s)
                  (return-from f nil))
              e)))
    (dolist (o (print (f l)) p)
      (dotimes (i o) (setf p `(cdr ,p)))
      (setf p `(car ,p)))))

Thí dụ

(funcall *fun* '(4 5 (1 2 (7) 9 (10 8 14))) 14)

Danh sách được trích dẫn, nhưng nếu bạn thực sự muốn, tôi có thể sử dụng macro. Giá trị được trả về là [1] :

(CAR (CDR (CDR (CAR (CDR (CDR (CDR (CDR (CAR (CDR (CDR L)))))))))))

Đối với các bài kiểm tra, tôi đã sử dụng để tạo một biểu mẫu lambda trong đó lcó một biến:

(LAMBDA (#:G854) (CAR (CDR (CDR (CAR (CDR (CDR (CDR (CDR (CAR (CDR (CDR #:G854))))))))))))

Gọi đây với danh sách ban đầu trả về 14.


[1] (caddar (cddddr (caddr l)))cũng sẽ rất tuyệt


2
Bạn đã trả lời một câu hỏi về Lisp với Lisp! Đó là sự lừa dối!
DanTheMan

4
@DanTheMan Lisp-cece là khá nhiều những gì định nghĩa Lisp ;-)
coredump

9

Võng mạc , 170 142 125 115 114 87 84 83 75 73 70 69 68 67 byte

Yay, ít hơn 50% trong số hơn 100 byte trong lần thử đầu tiên của tôi. :)

\b(.+)\b.* \1$
(
^.
l
\(
a
+`a *\)|\d


d
+`(.*[l)])(\w)
(c$2r $1)

Để chạy mã từ một tệp duy nhất, sử dụng -scờ.

Tôi vẫn không tin điều này là tối ưu ... Tôi sẽ không có nhiều thời gian trong vài ngày tới, tôi sẽ thêm một lời giải thích cuối cùng.


5

Bình thường, 62 byte

JvXz"() ,][")u?qJQG&=J?K}Quu+GHNY<J1)hJtJ++XWK"(cdr "\d\aG\)\l

Dùng thử trực tuyến: Trình diễn hoặc Test Suite

Giải trình:

Bit đầu tiên JvXz"() ,][")thay thế các ký tự "() "bằng các ký tự "[],"trong chuỗi đầu vào, kết thúc bằng một đại diện của danh sách kiểu Python. Tôi đánh giá nó và lưu trữ nó trong J.

Sau đó tôi giảm chuỗi G = "l"với u...\l. Tôi ...liên tục áp dụng chức năng bên trong G, cho đến khi giá trị Gkhông thay đổi nữa rồi in G.

Hàm bên trong thực hiện các thao tác sau: Nếu Jđã bằng số đầu vào, hơn là không sửa đổi G( ?qJQG). Nếu không, tôi sẽ làm phẳng danh sách J[:1]và kiểm tra xem số đầu vào có nằm trong danh sách đó không và lưu số này vào biến K( K}Quu+GHNY<J1)). Lưu ý rằng Pyth không có toán tử làm phẳng, do đó, việc này mất khá nhiều byte. Nếu Klà đúng, hơn là tôi cập nhật J với J[0], nếu không thì với J[1:]( =J?KhJtJ). Và sau đó tôi thay thế Gvới "(cdr G)"và thay thế dcác a, nếu Klà đúng ( ++XWK"(cdr "\d\aG\)).


5

Lược đồ (R5RS), 102 byte

(let g((l(read))(n(read))(o'l))(if(pair? l)(or(g(car l)n`(car,o))(g(cdr l)n`(cdr,o)))(and(eq? n l)o)))

1

PHP - 177 byte

Tôi đã thêm một số dòng mới để dễ đọc:

function f($a,$o,$n){foreach($a as$v){if($n===$v||$s=f($v,$o,$n))return
'(car '.($s?:$o).')';$o="(cdr $o)";}}function l($s,$n){echo f(eval(strtr
("return$s;",'() ','[],')),l,$n);}

Đây là phiên bản chưa được chỉnh sửa:

function extractPhp($list, $output, $number)
{
    foreach ($list as $value)
    {
        if (is_int($value))
        {
            if ($value === $number) {
                return '(car '. $output .')';
            }
        }
        else
        {
            $subOutput = extractPhp($value, $output, $number);
            if ($subOutput !== null) {
                return '(car '. $subOutput .')';
            }
        }

        $output = '(cdr '. $output .')';
    }
}

function extractLisp($stringList, $number)
{
    $phpCode = 'return '. strtr($stringList, '() ','[],') .';';
    $list = eval($phpCode);
    echo extractPhp($list, 'l', $number);
}

1

Haskell, 190 188 byte

l "(4 5 (1 2 (7) 9 (10 8 14)))" 8

đánh giá

"(car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))"

l(h:s)n=c$i(show n)s""""
i n(h:s)t l|h>'/'&&h<':'=i n s(t++[h])l|t==n='a':l|h=='('=j$'a':l|h==')'=j$tail$dropWhile(=='d')l|0<1=j$'d':l where j=i n s""
c[]="l"
c(h:s)="(c"++h:"r "++c s++")"

1
Bạn có thể biến (ctrong chức năng cthành một chuỗi:c(h:s)="(c"++h:...
nimi

Wow, không nghĩ rằng nó sẽ làm việc với htư cách là một Char!
Leif Willerts 30/9/2015

0

Lisp thường gặp, 168 155 byte

Một số điều đệ quy ngu ngốc, nó có thể có thể được cô đọng hơn một chút:

(lambda(l e)(labels((r(l o)(setf a(car l)d(cdr l)x`(car,o)y`(cdr,o))(if(equal e a)x(if(atom a)(r d y)(if(find e l)(r d y)(if d(r d y)(r a x)))))))(r l'l)))

In đẹp:

(lambda (l e)
  (labels ((r (l o)
             (setf a (car l) d (cdr l)
                   x `(car ,o) y `(cdr ,o))
             (if (equal e a) x
                 (if (atom a)
                     (r d y)
                     (if (find e l)
                         (r d y)
                         (if d
                             (r d y)
                             (r a x)))))))
    (r l 'l)))
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.