Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun check (x &optional (l '(I V X L C D M)) (c 1))
- (cond ((null l) 0)
- ((eq x (car l)) c)
- (t (check x (cdr l) (+ c 1)))))
- (defun f2(lis &optional (lst nil) )
- (
- let ((cur (car lis))
- (nxt (cadr lis)))
- (let ((cVal (check cur))
- (curHalf (member cur '(V L D)) ))
- (let ((sb (< cVal (check nxt))))
- (
- cond
- ( (null lis) t )
- ( (and sb curHalf) nil ) ; если вычитание половинки (cur = V L D)
- ( (and sb (eq cur (caddr lis))) nil) ; если после вычитания добавляется то, что вычитается (X L X)
- ( (and lst (> (check nxt) (check lst))) nil) ; если следующий>предыдущего(X X L)
- ( t (f2 (cdr lis) cur) )
- )
- ))))
- ; счетчик числа вхождений ch в списке l
- (defun counter (ch l &optional (c 0))
- (
- cond
- ( (null l) c )
- ( (eq ch (car l)) (counter ch (cdr l) (+ c 1)) )
- ( t (counter ch (cdr l) c))
- ))
- ; проверка допустимых вхождений римских цифр
- (defun checkRep(l)
- (
- and ( <= (counter 'I l) 3)
- ( <= (counter 'V l) 1)
- ( <= (counter 'X l) 3)
- ( <= (counter 'L l) 1)
- ( <= (counter 'C l) 3)
- ( <= (counter 'D l) 1)
- ( <= (counter 'M l) 4)
- ))
- (defun checkRom (l)
- (
- cond
- ( (null l) t )
- ( (not (member (car l) '(I V X L C D M))) nil )
- ( t (checkRom (cdr l)) )
- ))
- (defun f(l)
- (
- and (checkRom l) (checkRep l) (f2 l)
- ))
- ;(trace f2)
- ;(trace check)
- (print (f '(x x i v i))) ; t
- (print (f '(X C L ))) ; nil
- (print (f '(L X L ))) ; nil
- (print (f '(C D L X X X I I ))) ; t
- (print (f '(M C M X C I X))) ; t
- (print (f '(D C C C ))) ; t
- (print (f '(X V C))) ; nil
- (print (f '(X L X))) ; nil
- (print (f '(X X X X))) ; nil
- (print (f '(L X L ))) ; nil
- (print (f '(V L D D))) ; nil
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement