리스프 추출 임무


19

Lisp 스타일 언어에서 목록은 일반적으로 다음과 같이 정의됩니다.

(list 1 2 3)

이 문제를 해결하기 위해 모든 목록에는 양의 정수 또는 다른 목록 만 포함됩니다. 또한 list시작시 키워드를 생략 하므로 목록은 다음과 같습니다.

(1 2 3)

를 사용하여 목록의 첫 번째 요소를 얻을 수 있습니다 car. 예를 들면 다음과 같습니다.

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

그리고 첫 번째 요소를 제거하여 원래 목록을 얻을 수 있습니다 cdr.

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

중요 : cdr목록에 단일 요소가 있더라도 항상 목록을 반환합니다.

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

목록은 다른 목록 안에있을 수도 있습니다.

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

목록에서 특정 정수 를 사용 car하고 리턴하는 코드를 리턴하는 프로그램을 작성 cdr하십시오. 프로그램이 반환하는 코드에서 목록이에 저장되고 l대상 정수가 l어딘가에 있고 모든 정수가 고유 하다고 가정 할 수 있습니다 .

예 :

입력: (6 1 3) 3

산출: (car (cdr (cdr l)))

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

산출: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

입력: (1 12 1992) 1

산출: (car l)


정수를 먼저 입력하고 목록을 두 번째로 입력 할 수 있습니까?
Martin Ender

@ MartinBüttner는 물론이다.
absinthe

에 대해 무엇을 (1 2 3) 16, 우리는 반환하여야한다 ()?
코어 덤프

@coredump 좋은 질문입니다. 대상 정수가 항상 표현식에 있다고 가정 할 수 있으므로 같은 경우 (1 2 3) 16는 표시되지 않습니다.
absinthe

리스트와 정수에 대해 두 개의 입력을받을 수 있습니까?
Blackhole

답변:


1

CJam, 59

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

온라인으로 사용해보십시오

설명:

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

커먼 리스프, 99

다음 99 바이트 솔루션은 멋진 Scheme 답변 의 CL 버전입니다 .

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

원래 positionand를 사용하려고 시도했지만 원하는 position-if만큼 컴팩트하지 않은 것으로 나타났습니다 (209 바이트).

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

넓히는

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

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

목록이 인용되어 있지만 실제로 원한다면 매크로를 사용할 수 있습니다. 반환 값은 [1]입니다 .

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

테스트 l를 위해 변수가있는 람다 양식을 생성했습니다 .

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

원래 목록으로 이것을 호출하면 14가 반환됩니다.


[1]도 (caddar (cddddr (caddr l)))좋을 것입니다


2
당신은 Lisp with Lisp 에 대한 질문에 답변했습니다 ! 리스프 인식입니다!
DanTheMan

4
@DanTheMan Lisp-ception은 Lisp를 정의하는 것과 거의 비슷합니다. ;-)
coredump

9

망막 , 170 142 125 115 114 87 84 83 75 73 70 69 68 67 바이트

예, 첫 번째 시도에서 100 바이트 이상 중 50 % 미만 입니다. :)

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


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

단일 파일에서 코드를 실행하려면 -s플래그를 사용하십시오 .

나는 이것이 이것이 최적이라고 확신하지 못한다 ... 나는 앞으로 며칠 동안 많은 시간을 갖지 않을 것이며, 결국 설명을 추가 할 것이다.


5

Pyth, 62 바이트

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

온라인으로 사용해보십시오 : 데모 또는 테스트 스위트

설명:

첫 번째 비트 JvXz"() ,][")는 문자 "() ""[],"입력 문자열 의 문자 로 바꿉니다.이 문자열은 파이썬 스타일 목록으로 표시됩니다. 평가하고에 저장합니다 J.

그런 다음 줄을 줄입니다 G = "l" 을 입니다 u...\l. 의 값이 더 이상 변경되지 않을 때까지 내부 함수를 ...반복해서 적용한 다음 인쇄 합니다.GGG

내부 함수는 다음을 수행합니다. J이미 입력 번호와 같은 경우 수정하지 마십시오 G( ?qJQG). 그렇지 않으면 목록을 평평하게하고 J[:1]입력 번호가 해당 목록에 있는지 확인하고 변수 K( K}Quu+GHNY<J1))에 저장합니다 . Pyth에는 flatten 연산자가 없으므로 꽤 많은 바이트가 필요합니다. 경우는 K내가 가진 J를 업데이트보다, 사실 J[0]그렇지 않은 경우에, J[1:]( =J?KhJtJ). 그리고 내가 교체 G"(cdr G)"와 교체 da경우, K사실 (++XWK"(cdr "\d\aG\) ).


5

체계 (R5RS), 102 바이트

(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 바이트

가독성을 위해 몇 가지 줄 바꿈을 추가했습니다.

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

ungolfed 버전은 다음과 같습니다.

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

하스켈, 190 188 바이트

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

~에 평가하다

"(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
당신은 회전 수 (c기능에 c문자열로 :c(h:s)="(c"++h:...
nimi

와우, 그게 h차르가 될 수 있다고 생각하지 않았습니다 !
Leif Willerts

0

커먼 리스프, 168 바이트

어리석은 재귀 문제는 아마도 조금 더 응축 될 수 있습니다.

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

꽤 인쇄 :

(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)))
당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.