Следующая страница > 1 < [2]

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

leest

Members


Статус

12 сообщений

Где: 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


Статус

64 сообщений

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

#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


Статус

12 сообщений

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

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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


Статус

12 сообщений

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

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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


Статус

64 сообщений

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

#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

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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


Статус

12 сообщений

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

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

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

Михаил

Members


Статус

120 сообщений

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

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

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

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: 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)

Vera Naumova

Members


Статус

16 сообщений

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

#3543   2010-11-23 17:20 GMT+3 часа(ов)      
Всем привет!! мне тоже очень нужна помощь, подскажите пожалуйста, кто может. задача такая же как и у leest, перевод риммских цифр в арабские. только вот как это сделать, если занимаюсь лиспом самостоятельно, учусь на заочном, и надо уже сдавать буквально на неделе. понимаю, что сама не разберусь! подскажите пожалуйста самый простой алгоритм на xlisp, и если можно с подробными объяснениями, и тоже без функций аssoc и т.д., все на самом простом алгоритме. Уважаемый, leest, если у вас получилось, буду вам очень признательна, если вы поделитесь со мной решением. с огромной надеждой на любую помощь и понимание.

VH

Members


Статус

289 сообщений

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

#3544   2010-11-23 18:03 GMT+3 часа(ов)      
(defun F (roman &optional (table '((I . 1)(V . 5)(X . 10)(L . 50)(C . 100)(D . 500)(M . 1000))))
(if roman
((lambda (curr tail)
(if (null tail) curr
((lambda (next result)
(funcall (if (< curr next) '- '+) result curr))
(cdr (assoc (car tail) table))
(F tail))))
(cdr (assoc (car roman) table))
(cdr roman))))

Аргумент вызова функции (F) - список символов, представляющий римское числительное: (F '(M C M X C I I))


 

Vera Naumova

Members


Статус

16 сообщений

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

#3545   2010-11-23 18:07 GMT+3 часа(ов)      
VH, Спасибо вам за помощь, но для меня это слишком сложно, да, я проверила она работает, и работает правильно! Но... ни lambda, ни assoc, ни funcall нам не давали =(( т.е. нужен самый простой алгоритм, самые простые функции, если возможно, то буду очень признательна. Но всё равно, большое вам человеческое спасибо!!!!

VH

Members


Статус

289 сообщений

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

#3546   2010-11-23 18:25 GMT+3 часа(ов)      
Если б такие преподы были главными - колеса б люди до сих пор не изобрели.
Я не публикую работающие неправильно функции.
А что Вам «давали»?

Vera Naumova

Members


Статус

16 сообщений

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

#3547   2010-11-23 18:44 GMT+3 часа(ов)      
это точно замечено=))) ну я сейчас думаю, как бы сделать ее с помощью equal или set, и с помощью простейших операторов if, cond, возможно reverse пригодится и рекурсия.

VH

Members


Статус

289 сообщений

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

#3548   2010-11-23 18:47 GMT+3 часа(ов)      
(defun F (roman &optional (table '((I . 1)(V . 5)(X . 10)(L . 50)(C . 100)(D . 500)(M . 1000))))
(if roman
(let
((curr (cdr (assoc (car roman) table)))
(tail (cdr roman)))
(if tail
(let
((next (cdr (assoc (car tail) table)))
(result (F tail)))
(if (< curr next)
(- result curr)
(+ result curr)))
curr))))


Онлайн :

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