Misi Ekstraksi Lisp

19

Dalam bahasa gaya Lisp, daftar biasanya didefinisikan seperti ini:

(list 1 2 3)

Untuk keperluan tantangan ini, semua daftar hanya akan berisi bilangan bulat positif atau daftar lainnya. Kami juga akan meninggalkan listkata kunci di awal, sehingga daftar sekarang akan terlihat seperti ini:

(1 2 3)

Kita bisa mendapatkan elemen pertama dari daftar dengan menggunakan car. Sebagai contoh:

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

Dan kita bisa mendapatkan daftar asli dengan elemen pertama dihapus dengan cdr:

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

Penting: cdrakan selalu mengembalikan daftar, meskipun daftar itu memiliki satu elemen:

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

Daftar juga dapat berada di dalam daftar lain:

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

Tulis program yang mengembalikan kode yang menggunakan cardan cdruntuk mengembalikan integer tertentu dalam daftar. Dalam kode yang dikembalikan oleh program Anda, Anda dapat mengasumsikan bahwa daftar tersebut disimpan l, bilangan bulat target ada di lsuatu tempat, dan bahwa semua bilangan bulat itu unik.

Contoh:

Memasukkan: (6 1 3) 3

Keluaran: (car (cdr (cdr l)))

Memasukkan: (4 5 (1 2 (7) 9 (10 8 14))) 8

Keluaran: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Memasukkan: (1 12 1992) 1

Keluaran: (car l)

Absinth
sumber
Bisakah kita mengambil input dengan integer pertama dan daftar kedua?
Martin Ender
@ MartinBüttner Tentu.
absinthe
Bagaimana kalau (1 2 3) 16kita kembali ()?
coredump
@coredump Pertanyaan bagus. Anda dapat mengasumsikan bahwa target integer akan selalu dalam ekspresi, jadi case seperti (1 2 3) 16ini tidak akan pernah muncul.
absinthe
Bisakah kita menerima dua input, satu untuk daftar dan satu untuk integer?
Blackhole

Jawaban:

1

CJam, 59

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

Cobalah online

Penjelasan:

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
aditsu
sumber
10

Common Lisp, 99

Solusi 99 byte berikut adalah versi CL dari jawaban Scheme yang bagus .

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

Saya awalnya mencoba memanfaatkan positiondan position-if, tetapi ternyata tidak sekompak yang saya inginkan (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)))))

Diperluas

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

Contoh

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

Daftar ini dikutip, tetapi jika Anda benar-benar ingin, saya bisa menggunakan makro. Nilai yang dikembalikan adalah [1] :

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

Untuk tes, saya biasa membuat formulir lambda ldengan variabel:

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

Menyebut ini dengan daftar asli mengembalikan 14.


[1] (caddar (cddddr (caddr l)))akan menyenangkan juga

coredump
sumber
2
Anda menjawab pertanyaan tentang Lisp dengan Lisp! Ini adalah Lisp-ception!
DanTheMan
4
@DanTheMan Lisp-ception adalah apa yang mendefinisikan Lisp ;-)
coredump
9

Retina , 170 142 125 115 114 87 84 83 75 73 70 69 68 67 byte

Ya, kurang dari 50% lebih dari 100 byte dari upaya pertama saya. :)

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


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

Untuk menjalankan kode dari satu file, gunakan -sbendera.

Saya masih tidak yakin ini optimal ... Saya tidak akan punya banyak waktu selama beberapa hari ke depan, saya akan menambahkan penjelasan pada akhirnya.

Martin Ender
sumber
5

Pyth, 62 byte

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

Cobalah online: Demonstrasi atau Test Suite

Penjelasan:

Bit pertama JvXz"() ,][")menggantikan karakter "() "dengan karakter "[],"di string input, yang berakhir dengan representasi daftar gaya-Python. Saya mengevaluasi dan menyimpannya di J.

Lalu aku mengurangi string G = "l"dengan u...\l. Saya menerapkan fungsi dalam ...berulang kali G, hingga nilai Gtidak berubah lagi dan kemudian mencetak G.

Fungsi dalam melakukan hal berikut: Jika Jsudah sama dengan nomor input, daripada jangan modifikasi G( ?qJQG). Kalau tidak, saya akan meratakan daftar J[:1]dan memeriksa apakah nomor input dalam daftar itu dan menyimpannya ke variabel K( K}Quu+GHNY<J1)). Perhatikan bahwa Pyth tidak memiliki operator yang rata, jadi ini membutuhkan beberapa byte. Jika Kbenar, maka saya memperbarui J dengan J[0], jika tidak dengan J[1:]( =J?KhJtJ). Dan kemudian saya ganti Gdengan "(cdr G)"dan mengganti dyang a, jika Kbenar ( ++XWK"(cdr "\d\aG\)).

Jakube
sumber
5

Skema (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)))
Anders Kaseorg
sumber
1

PHP - 177 byte

Saya telah menambahkan beberapa baris baru untuk keterbacaan:

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);}

Ini adalah versi yang tidak disunat:

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);
}
Lubang hitam
sumber
1

Haskell, 190 188 byte

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

mengevaluasi ke

"(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++")"
Leif Willerts
sumber
1
Anda dapat mengubah (dan cberfungsi cmenjadi string:c(h:s)="(c"++h:...
nimi
Wow, tidak berpikir itu akan berhasil dengan hmenjadi Char!
Leif Willerts
0

Common Lisp, 168 155 byte

Beberapa hal rekursi bodoh, mungkin bisa sedikit lebih pendek:

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

Cukup dicetak:

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