Перевод из римских в арабские числа

[PuzzleC]

winnix, привет, Что надо сделать? Всю программу, или подсказать? Язык какой?

[mihali4]

Язык какой?

Читайте первый пост...

[theos]

http://ru.wikipedia.org/wiki/Римские числа

Правила, насколько помню, такие - I - 1, V - 5, X - 10, L - 50, C - 100, D - 500, M - 1000.

Число складывается из таких кусков - ставятся единицы по количеству (ХХ = 20, DCL = 650) в порядке уменьшения, числа на какую-то из единиц меньше другой можно записывають этими ед-ми, но в обратном порядке (XL = 40, IC = 99). Соотв у нас появляются разные вар-ты написания одного числа. Лисча больше 1000 записываются с разделителем m (CXmDLII = 110552) (это правило появилось поздно, странно, что они не перешли на совсем позиционную запись)

Алгоритм перевода вообще простой, на С написал бы.

[winnix]

спасибо..
извини пожалуйста...
А нельзя эту задачу решить доугим способом?
а то это решение я понимаю на 50 процентов.Можно сделать с циклами и массивами...?попроще...умственное развитие не такое как у вас..А то мне перед преподом объяснять и мне это не сделать...
буду очень блогадарен))

[kommunist]

Сообщение от winnix

А нельзя эту задачу решить доугим способом?
а то это решение я понимаю на 50 процентов.Можно сделать с циклами и массивами...?попроще...умственное развитие не такое как у вас..А то мне перед преподом объяснять и мне это не сделать...
буду очень блогадарен))

Можно
___________________________

Const
legals = 'IVXLCDM';
values:  Array[1 .. 7] Of Word =    (1, 5, 10, 50, 100, 500, 1000);
Var 
s: String;
i: Byte;
value, v, c: Integer;
Begin 
WriteLn('Примеры чисел:'); 
writeln('XXVIII=28  XXXIX=39  CCCXCVII=397  MDCCCXVIII=1818'); 
Write('Введите римское число: '); 
ReadLn(s); 
For i := 1 To Length(s) Do   
If Pos(UpCase(s[i]), legals) = 0 
Then     
Begin       
WriteLn('Ошибка - неверный символ "',s[i],'"'); 
Halt     
End   
Else s[i] := Upcase(s[i]);
 v := values[Pos(s[1], legals)]; 
value := 0; c := 1; 
For i := 2 To Length(s) Do   
If Pos(s[Pred(i)],legals) <> Pos(s[i],legals) 
Then     
Begin       
c := c * (Byte(pos(s[Pred(i)],legals) > Pos(s[i],legals))*2 - 1);      
 If c < (-1) Then      
   Begin         
  value := -v * c -10001; 
Break       
  End      
 Else Inc(value, v * c);     
  v := values[Pos(s[i], legals)];     
  c := 1;   
  End  
 Else     
If c > 2 Then      
 Begin      
   value := -v * c - 10000; 
Break;     
  End    
 Else Inc©;
 Inc(value, v * c); 
Case value Of   -10000: 
WriteLn('Ошибка: больше 3 одинаковых элементов');   
-10001: WriteLn('Ошибка: присутствует более одного меньшего элемента');  
 -9999..-1: WriteLn('Ошибка: отрицательный результат');  
 0: WriteLn('Ошибка: сгенерирован 0')  
 else WriteLn('Арабское число: ',value); 
End;
End.

[winnix]

Сообщение от kommunist

посмотри вот это

Че то она не работает((
А что такое Cur в твоей проге??ВОт эта таблица это что?И как в этой проге сделать так чтобы про вводе некорректного числа она не висла а выдавала что введено некорректно?
объясни пожалуйста а то я не могу разобраться...

[winnix]

Сообщение от PuzzleC

winnix, привет, Что надо сделать? Всю программу, или подсказать? Язык какой?

всю....если можешь)))

[kommunist]

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Const

R: Array[1..13] of String[2] =

('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');

A: Array[1..13] of Integer=

(1,4,5,9,10,40,50,90,100,400,500,900,1000);

Function Roman(N : Integer) : String;

Var
    Resuly : String;

    i      : Integer;

begin

 Result := '';

 i := 13;

 While N >0 do

 begin

   While A[i] >N do Dec(i);

   Result := Result + R[i];
 Dec(N, A[i]);
end;
 Roman := Result;
end;
Function Arabic(S : String) : Integer;
Var Resuly : Integer;
 i, p   : Integer;
begin
Arabic := -1;
Result := 0;
i := 13;
p := 1;
While p <=Length(S) do
begin
 While Copy(S, p, Length(R[i])) <>R[i] do
 begin
Dec(i);
 If i = 0 then Exit;
 end;
 Result := Result + A[i];
 p := p + Length(R[i]);
 end;
If Roman(Result) = S then Arabic := Result
end;
Var N, Err : Integer;
 S : String;
BEGIN
 repeat
ReadLn(S);
If S = '' then Break;
Val(S, N, Err);
 If Err = 0 then
WriteLn(Roman(N))
 else
WriteLn(Arabic(S));
 until false;
end.

[winnix]

спасибо ВАМ БОЛЬШОЕ)))
Только я немного переделал(там когда -1 я вывел некорректный ввод)
Но это не меняет саму структуру проги...спасибо.спасибо...спасибо.. .

[eiolve]

kommunist спасибо огромное. Все работает. Только вот я теперь с типизированными константами разбираюсь. Я с ними первый раз столкнулся.
И чтобы некорректную запись определять - легко. Когда вводишь XCIXCI (неправильная запись римского числа) Постусловие инициирует зацикливание. Все что нам надо - это вставить в цикл переменную inc('переменная'). Всего основных конструкций 13 поэтому мы вводим условие
If 'переменная' >14 then {условие лучше поставить до inc('переменная') и если работать с задачей kommunist'а http://www.programmersforum.ru/attac...2&d=1197648162 то там уже есть 'переменная' Inc(CurNum); если работать с ней, то условие будет выглядеть как ...If CurNum >14 then...}
begin
Writeln('Запись некорректна');
break; {завершаем цикл}
end;

Потом еще надо добавить условие на вывод результата..
Исходники выложу послезавтра, сегодня флешку потерял епт.