> 1 <

Автор Сообщение

leest

Members


Статус

11 сообщений

Где: Russia
Род занятий:
Возраст:

#1535   2010-03-10 19:25 GMT+3 часа(ов)      
Здравствуйте всем! программирование на xLisp начал изучать недавно, поэтому нуждаюсь в помощи экспертов. Задача состоит в том, чобы написать функцию (f n), которая переводила бы риммские цифры в арабские... в общем я столкнулся тут с двумя проблемами: во-первых: как сопоставить буквы латинского алфавита с определнным числом? Например: (I - это 1, V - 5, X - 10, L - 50, C - 100, D - 500, M - 1000) пробовал с помощью set и setq, что-то у меня не выходит)) но не считая эту проблему имеется еще одна, сам алгоритм у меня получился такой:

(defun f (n)
(cond
((null n) 0)
((< (first n) (f (rest n))) (- (f (rest n)) (first n)))
(t (+ (first n) (f (rest n))))
)
)

т.е. если вводишь (f '(100 500 50 10 10 10 1 1)) выводит 462, вместо нужного 482. в чем ошибка я понимаю, мне нужно сначала заменить сдвоенные и строенные числа (т.е. 10 10 10), на их сумму (30), тогда все будет считать верно (останется сопоставить с латинским эквивалентом представления числа). Вот. может, я что-то усложняю? Заранее спасибо за помощь!

asbest

Members


Статус

62 сообщений

Где: Russia
Род занятий:
Возраст:

#1537   2010-03-11 06:51 GMT+3 часа(ов)      
Для сопоставления можно использовать функцию assoc.
Для нее нужно составить список точечных пар, например '((v . 5) (x . 10) (l . 50))
Тогда
>(assoc 'd '((v . 5) (x . 10) (l . 50)))
NIL
>(assoc 'x '((v . 5) (x . 10) (l . 50)))
(X . 10)
>(cdr (assoc 'x '((v . 5) (x . 10) (l . 50))))
10

Должна быть в xlisp. Более современно и эффективно использовать хеш-таблицы, не уверен, есть ли они в xlisp.
Рекомендую переходить на YLisp. По алгоритму не смогу подсказать, т.к. плохо разбираюсь в римских цифрах.

отредактировал(а) asbest: 2010-03-11 11:49 GMT+3 часа(ов)

leest

Members


Статус

11 сообщений

Где: Russia
Род занятий:
Возраст:

#1540   2010-03-11 14:20 GMT+3 часа(ов)      
Спасибо,попробую.а кто-нибудь может ещё предложить решения данных проблем?буду очень признателен.

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1542   2010-03-11 17:38 GMT+3 часа(ов)      
> (f '(100 500 50 10 10 10 1 1))
(reverse '(100 500 50 10 10 10 1 1))

=> (1 1 10 10 10 50 500 100)

Римские цифры проще расшифровывать с конца.

leest

Members


Статус

11 сообщений

Где: Russia
Род занятий:
Возраст:

#1544   2010-03-13 01:21 GMT+3 часа(ов)      
Я и с помощью реверта тоже делал,там алгоритм меняется маленько.но он опять же не всегда считает правильно.например: (f '(100 1000 50 10 1 10)),вместо 969 он выдаст 971.люди,помогите пожалуйста,я уже не знаю что пробовать!

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1545   2010-03-13 03:56 GMT+3 часа(ов)       
(define (Roman l)

  (letrec ((symbol->rnum

            (lambda(symb)

              (map lroman->int (map char-upcase (string->list (symbol->string symb))))))

           (lroman->int 

            (lambda(rnum)

              (cdr (assq rnum 

                   '((#\I . 1)  (#\V . 5) (#\X . 10) (#\L . 50) 

                     (#\C . 100) (#\D . 500) (#\M . 1000))))))

           (roman 

             (lambda (num pattern l)

               (cond

                 ((null? l) 

                  (+ pattern num))

                 ((= pattern 0)

                  (roman 0 (car l) (cdr l)))

                 ((< pattern (car l))

                  (+ (car l) ((if (zero? num) - +) pattern)

                     num (roman 0 0 (cdr l))))

                 ((= pattern (car l))

                  (roman (+ (car l) num) pattern (cdr l)))

                 (else 

                  (+ (+ pattern num) (roman 0 (car l) (cdr l))))))))

    (roman 0 0 (symbol->rnum l))))

> (roman 'CDLXXXII)

482

> (roman 'DCXCV)

695

> (roman 'DCCCLXXXVIII)

888

отредактировал(а) misha: 2010-03-14 13:51 GMT+3 часа(ов)

asbest

Members


Статус

62 сообщений

Где: Russia
Род занятий:
Возраст:

#1546   2010-03-13 10:57 GMT+3 часа(ов)      
По-моему, это Scheme, а не Лисп.
Вот мой вариант
Можно убрать дублирование кода в roman-helper, но для понятности примера лучше оставить

 

(defun roman-helper (prev list)

  (if list

    (if (< (car list) prev)

       (- (roman-helper (car list) (cdr list)) (car list))

       (+ (roman-helper (car list) (cdr list)) (car list)))

    0))

 

(defun roman-digit-value (digit)

  (cdr (assoc digit '((I . 1)  (V . 5) (X . 10) (L . 50) (C . 100) (D . 500) (M . 1000)))))

 

(defun roman (rnum)

  (roman-helper 0 (reverse (mapcar #'roman-digit-value rnum))))

 


>(roman '(I X))
9
>(roman '(I X X))
19
>(roman '(C D L X X X I I))
482
>(roman '(D C X C V))
695
>

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1547   2010-03-13 20:33 GMT+3 часа(ов)       
(defun Roman (lrnum)

  (labels ((roman->int (rnum)

            (cdr (assoc rnum 

                 '((I . 1)  (V . 5) (X . 10) (L . 50) 

                   (C . 100) (D . 500) (M . 1000)))))

           (roman (num pattern l)

            (cond

             ((null l) 

              (+ pattern num))

             ((= pattern 0)

              (roman 0 (car l) (cdr l)))

             ((< pattern (car l))

              (+ (car l) (if (zerop num) (- pattern) pattern)

                 num (roman 0 0 (cdr l))))

             ((= pattern (car l))

              (roman (+ (car l) num) pattern (cdr l)))

             (t (+ (+ pattern num) (roman 0 (car l) (cdr l))))))) 

    (Roman 0 0 (mapcar #'roman->int lrnum))))

 

> (roman '(D C C C L X X X V I I I))    

888                                     

> (roman '(C D L X X X I I))            

482                                     

> (roman '(d c x c v))                  

695                                     

> (roman '(M C M L X X X I X))          

1989

отредактировал(а) misha: 2010-03-14 14:14 GMT+3 часа(ов)

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1548   2010-03-13 21:36 GMT+3 часа(ов)      
Ладно ребятки, молодцы, с этим вы справились. А теперь давайте быстренько мне напишите тоже самое, только в другую сторону: арабские в римские.

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1551   2010-03-14 00:03 GMT+3 часа(ов)      
Кстати, вот мое решение для перевода римских в арабские:
(define (roman->arabic lst)

  (foldr (lambda (a b)

           (list (if (< a (caddr b)) '- '+) b a))

         '(+ 0 0) lst))

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1552   2010-03-14 13:33 GMT+3 часа(ов)      
Молодец справился! А про eval забыл? Перепиши ка это на xLisp-е.
И еще добавь возможность использования "зеркальных" чисел: IIX = XII = 12.

отредактировал(а) misha: 2010-03-14 13:56 GMT+3 часа(ов)

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1553   2010-03-14 21:38 GMT+3 часа(ов)      
> А про eval забыл?
Главное, что ты мишаня вспомнил.

> IIX = XII = 12
Не позорь себя.

Ну так что, можешь написать переводчкик арабских в римские?

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1554   2010-03-14 22:17 GMT+3 часа(ов)      
>Главное, что ты мишаня вспомнил.
Исправь. И добавь, что это PLT Scheme Pretty Big.

>> IIX = XII = 12
>Не позорь себя.
Есть такой прием - записывать римские числа неправильным "зеркальным" способом, применяется в основном в нумерологии, алхимии. Например, XIIV является неправильной записью числа XVII. Поэтому существует два значения: 15 и 17, полезно при сокрытии информации.

>Ну так что, можешь написать переводчкик арабских в римские?
Не интересно. Представь код - я заценю

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1555   2010-03-14 22:48 GMT+3 часа(ов)      
> Не интересно.
Тогда нам больше неочем говорить.

leest

Members


Статус

11 сообщений

Где: Russia
Род занятий:
Возраст:

#1556   2010-03-15 20:25 GMT+3 часа(ов)      
Спасибо всем, кто принимал участие в обсуждении и всем, кто просто смотрел! Отдельное спасибо Мише и Асбесту, все работает, осталось только разобраться что там к чему(((

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1560   2010-03-16 00:52 GMT+3 часа(ов)      
Моя предыдущая функция позволяла обрабатывать неправильные "зеркальные" числа. А для нормальных сойдет и эта:
(defun Roman (lrnum)

  (labels ((roman->int (rnum)

            (cdr (assoc rnum 

                 '((I . 1)  (V . 5) (X . 10) (L . 50) 

                   (C . 100) (D . 500) (M . 1000)))))

           (roman (prev l)

            (if (null l)

                prev

                (+ (if (>= prev (car l)) prev (- prev))

                   (roman (car l) (cdr l))))))

    (Roman 0 (mapcar #'roman->int lrnum))))

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1562   2010-03-16 01:59 GMT+3 часа(ов)      
Мишаня, ерунда твоя функция, ты лучше переводчик арабских в римские напиши.

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1563   2010-03-16 02:03 GMT+3 часа(ов)      
Ответ аргументируй.

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1564   2010-03-16 02:09 GMT+3 часа(ов)      
А ты сначала напиши то что я прошу и потом поговорим.

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1580   2010-03-16 16:18 GMT+3 часа(ов)       
(define (integer->roman num)

  (apply append

         (map (lambda (val)

                (do ((res '() (append res (cadr val)))

                     (i (truncate (/ num (car val))) (- i 1)))

                  ((<= i 0) (set! num (remainder num (car val))) res)))

              '((1000 (M)) (900 (C M)) (500 (D)) (400 (C D)) (100 (C))

                (90 (X C)) (50 (L)) (40 (X L)) (10 (X)) (9 (I X))

                (5 (V)) (4 (I V)) (1 (I))))))

 

>(integer->roman 1989)

(m c m l x x x i x)

отредактировал(а) misha: 2010-03-16 18:17 GMT+3 часа(ов)

Михаил

Members


Статус

120 сообщений

Где: ---
Род занятий:
Возраст:

#1620   2010-03-18 08:02 GMT+3 часа(ов)      
Молодец. Только
> (truncate (/ num (car val)))
для этих целей существует quotient. Я решил немного по-другому:
(define (arabic->roman num)

  (define (iter n m)

    (let ((r (remainder n 10))

          (q (quotient  n 10))

          (a '((0 ()) (1 (1)) (2 (1 1)) (3 (1 1 1)) (4 (1 5)) (5 (5))

               (6 (5 1)) (7 (5 1 1)) (8 (5 1 1 1)) (9 (1 10)))))

      (if (= n 0)

          '()

          (append

           (iter q (* m 10))

           (map (lambda (x) (* x m))

                (cadr (assq r a)))))))

  (iter num 1))

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1623   2010-03-18 12:24 GMT+3 часа(ов)      
>> (truncate (/ num (car val)))
>для этих целей существует quotient.
Это я вполне мог забыть, ведь аналога quotient нет в лиспе.
А почему бы тебе не добавить вывод в нормальной форме, например, как у меня.
> (arabic->roman 10000)
(10000)
А это что расширенный набор?

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1624   2010-03-18 12:41 GMT+3 часа(ов)      
>(if (= n 0)
Отрицательных римских чисел не бывает. (<= n 0)

misha

Members


Статус

465 сообщений

Где: Yemen
Род занятий:
Возраст:

#1626   2010-03-18 13:25 GMT+3 часа(ов)       
(define (integer->roman num)

  (if (< num 4000)

      (apply append

             (map (lambda (val)

                    (do ((res '() (append res (cadr val)))

                         (i (quotient num (car val)) (- i 1)))

                      ((<= i 0) (set! num (remainder num (car val))) res)))

                  '((1000 (M)) (900 (C M)) (500 (D)) (400 (C D)) (100 (C))

                    (90 (X C)) (50 (L)) (40 (X L)) (10 (X)) (9 (I X))

                    (5 (V)) (4 (I V)) (1 (I)))))

      (cons (integer->roman (quotient num 1000)) 

            (integer->roman (remainder num 1000)))))

 

>(integer->roman 11989)

((x i) c m l x x x i x)
> 1 <


Онлайн :

0 пользователь(ей), 23 гость(ей) :