Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.
Inc(value, v * c); Case value Of -10000: WriteLn('Ошибка: больше 3 одинаковых элементов'); -10001: WriteLn('Ошибка: присутствует более одного меньшего элемента'); -9999..-1: WriteLn('Ошибка: отрицательный результат'); 0: WriteLn('Ошибка: сгенерирован 0'); else WriteLn('Арабское число: ',value); End; End.
Программа переводит арабские числа в римские и наоборот:
const n = 13; { Всего рассматривается 13 комбинаций } pair: array[1 .. n] of record { Каждая подобная Пара однозначно определяет соответствие } r: string[2]; { заданого в виде строки римского числа (поле R) } a: integer; { арабскому числу, хранящемуся в поле A } end = ( (r: 'I' ; a: 1), (r:'IV' ; a: 4), (r: 'V' ; a: 5), (r:'IX' ; a: 9), (r: 'X' ; a: 10), (r:'XL' ; a: 40), (r: 'L' ; a: 50), (r:'XC' ; a: 90), (r: 'C' ; a: 100), (r:'CD' ; a: 400), (r: 'D' ; a: 500), (r:'CM' ; a: 900), (r: 'M' ; a: 1000) );
{ Функция перевода целого числа (value) в строку, представляющую его в римской системе } function ToRoman(value: integer): string; var theResult: string; i: integer; begin theResult := ''; i := n;
while value > 0 do begin
while pair[i].a > value do dec(i); theResult := theResult + pair[i].r; dec(value, pair[i].a);
end;
ToRoman := theResult; end;
{ Попытка перевода строки в арабское число. Если в строке содержатся неподходящие символы, или полученное арабское число, переведенное в римскую систему, выдает результат, отличающийся от входной строки S, считается, что произошла ошибка конвертации, и функция возвращает -1 } function ToArabic(s: string): integer; var theResult: integer; i, pos: integer; begin ToArabic := -1; theResult := 0;
i := n; pos := 1;
while pos <= length(s) do begin
while copy(s, pos, length(pair[i].r)) <> pair[i].r do begin
dec(i); { I будет равняться 0 только если во входной строке встречается некорректный символ } if i = 0 then exit;
end; { Проверяем результат переводом его назад в римскую систему } if ToRoman(theResult) = s then ToArabic := theResult end;
var value, Err: integer; s: string;
begin
{ Программа будет работать, пока пользователь не введет пустую строку } repeat write('--> '); readLn(s);
if s <> '' then begin
{ Пытаемся перевести строку в число } val(s, value, Err);
{ Если это удалось (Err = 0), то было введено арабское число, иначе - _возможно_ введено римское число } if Err = 0 then writeln(ToRoman(value)) else writeln(ToArabic(s));
end;
until s = '';
end.
Ну, и если кому-то понадобится рекурсивная функция перевода арабских чисел в римские - вот она: