VPF::Римские числа - Форум программистов

Сый

Дата 20.3.2006, 15:58 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 131
Регистрация: 23.1.2006

Репутация: 2
Всего: 3

Нашёл программу для перевода римских чисел в арабские:

Код


ОТДЕЛ РвА+;

ИСПОЛЬЗУЕТ
  ОС       ИЗ "...\Отделы\Обмен\",
  Параметр ИЗ "...\Отделы\Обмен\",
  Вывод    ИЗ "...\Отделы\Обмен\";

ПЕР s:РЯД 30 ИЗ ЗНАК;
    n,c,c1,i,a:ЦЕЛ;

УКАЗ
  Параметр.Текст(1,s);
  c:=0; n:=0;
  ОТ i:=0 ДО ДЛИНА(s)-1 ВЫП
    c1:=c;
    ВЫБРАТЬ s[i] ИЗ
      'I': c:=1
    | 'V': c:=5
    | 'X': c:=10
    | 'L': c:=50
    | 'C': c:=100
    | 'D': c:=500
    | 'M': c:=1000
    ИНАЧЕ КОН;
    ЕСЛИ c>c1 ТО a:=-2*c1
           ИНАЧЕ a:=0 КОН;
    n:=n+a+c
  КОН;
  Вывод.ЧЦел("%d",n,0,0,0)

КОН РвА.

А нужны мне также обратная программа (арабские в римские) и проверка правильности вписанного римского числа.

--------------------

Язык программирования, родственный языкам Паскаль и Оберон, использующий русские служебные слова - Глагол: http://glagol.nad.ru

SoWa

Дата 20.3.2006, 20:11 (ссылка)

(нет голосов)

Загрузка ...

Харекришна

Профиль
Группа: Комодератор
Сообщений: 2422
Регистрация: 18.10.2004

Репутация: 6
Всего: 74

На нормальном русском Паскале:

Код


{Римские в арабские}
function RomanToDec(const Value: string): integer; 
var 
  i, lastValue, curValue: integer; 
begin 
  Result := 0; 
  lastValue := 0; 
  for i := Length(Value) downto 1 do 
  begin 
    case UpCase(Value[i]) of 
      'C': 
        curValue := 100; 
      'D': 
        curValue := 500; 
      'I': 
        curValue := 1; 
      'L': 
        curValue := 50; 
      'M': 
        curValue := 1000; 
      'V': 
        curValue := 5; 
      'X': 
        curValue := 10; 
    else 
      raise Exception.CreateFmt('Invalid character: %s', [Value[i]]); 
    end; 
    if curValue < lastValue then 
      Dec(Result, curValue) 
    else 
      Inc(Result, curValue); 
    lastValue := curValue; 
  end; 
end; 

{Арабские в Римские}
function IntToRoman(num: Cardinal): String;  {returns num in capital roman digits} 
const 
  Nvals = 13; 
  vals: array [1..Nvals] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000); 
  roms: array [1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M'); 
var 
  b: 1..Nvals; 
begin 
  result := ''; 
  b := Nvals; 
  while num > 0 do 
  begin 
    while vals[b] > num do 
      dec(b); 
    dec (num, vals[b]); 
    result := result + roms[b] 
  end; 
end;

//Взято из DRKB

Это сообщение отредактировал(а) SoWa - 20.3.2006, 20:13

--------------------

Всем добра smile

Сый

Дата 20.3.2006, 20:56 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 131
Регистрация: 23.1.2006

Репутация: 2
Всего: 3

Спасибо.

>На нормальном русском Паскале
Чем же он русский?

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Алгоритмы \| Следующая тема »