Проверить, правильна ли запись числа римскими цифрами.

[Alekzinder]

Помогите решить
Проверить, правильна ли запись числа римскими цифрами.

[hon]

Я видел, когда не было наработок, я видел, когда не было информации, в чем проблема, но чтобы не было условия (!), я такого не видел.

[Serge_Bliznykov]

hon, да чего уж тут непонятного?..
Автору топика нужен код программы на языке Паскаль, который по введённой строке определяет, корректная ли запись числа римскими цифрами и выдаёт сообщение правильна запись числа или нет. вот и всё...

[Stilet]

function IsRoman(s: String): Boolean;
const
  Romans:string =  'I IV V IX X XL L XC C CD D CM M ';
var
  i: Integer;
begin
  for i := 1 to Length(s) do
   if (pos(copy(s,1,1),Romans)=0) and (pos(copy(s,1,2),Romans)=0) then begin
    Result:=false; exit;
   end;
  Result := true;
end;

Применять как:

 if IsRoman('XVII') then write('Ога') else write('Неа');

Идея понятна?

[Serge_Bliznykov]

да "щас"!


XCIXCI
VXIIIIIICIXCI
IXIIIIIII
CXCIXI

Вы точно уверены, что данные записи представляют собой корректную запись числа римскими цифрами?!


я бы предложил такое решение (оно, конечно, наверняка не самое короткое и эффективное, зато рабочее!)

{Источник: "Наука и жизнь" N12 1986  cтр. 95 }
{Алгоритм: В. Птицын г.Москва }
{доработка 30.05.2010 - проверка входного римского числа на ошибочность}
type str2 = string[2];

const
   MaxVariant = 14;
const
   Rims : array[1..MaxVariant] of str2 = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I',' ');
   Arab : array[1..MaxVariant] of integer = (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1, 0);

var
  N, NI, I, J : integer;
  S    : string;

  function Arab2Rim(N : integer) : string;
  var S : string;
      I : integer;
  begin
    S := ''; I:=1;
    while N > 0 do begin
      while Arab[I]<=N do begin
        S := S + Rims[I];
        N := N - Arab[I]
      end;
      I:=I+1
    end;
    Arab2Rim := S
  end;

  function Rim2Arab (S:string) : integer;
  var I, N, Offset : integer;
    s0 : string;
  begin
    Rim2Arab := -1;
    I:=1; N := 0; Offset := 0; s0 := trim(S);
    while S<>'' do begin
      while Rims[I] = Copy(S, 1, Length(Rims[I]) ) do begin
        S := Copy( S, 1+Length(Rims[I]), 255);
        Offset := Offset + Length(Rims[I]);
        N := N + Arab[I]
      end;
      I:=I+1;
      if I>MaxVariant then begin
         {  WriteLn('Ошибка в исходной строке '+s0+' с позиции ',Offset:1); }
         exit
      end;
    end;
    if Arab2Rim(N)=s0 then  Rim2Arab := N;
  end;

var
  rimStr : string;
  rez : integer;
begin
  WriteLn('Перевод из арабских цифр в римские. 1999 B_SA');
  
  repeat
     WriteLn;
     Write('Введите число, римскими цифрами (пустая строка - выход): ');
     Readln(rimStr);
     if Trim(rimStr) <> '' then begin
        rez := Rim2Arab( rimStr );
        if  rez < 0 then
          WriteLn('Введённая запись НЕ является корректной записью числа римскими цифрами')
        else
          WriteLn('Это правильная запись! ( ', rez,' )');
     end;
  until Trim(rimStr) = '';
end.

[Alekzinder]

Большущее спасибо!) я бы даже не додумался таким способом решать

[Stilet]

Вы точно уверены

Нет. Я просто предложил.

[s-andriano]

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

да "щас"!


XCIXCI
VXIIIIIICIXCI
IXIIIIIII
CXCIXI

function IsRoman(s: String): Boolean;
const
  Romans:string =  'I IV V IX X XL L XC C CD D CM M ';
var
  i: Integer;
begin
  for i := 1 to Length(s) do
   if (pos(copy(s,1,1),Romans)=0) and (pos(copy(s,1,2),Romans)=0) then begin
    Result:=false; exit;
   end;
  Result := true;
end;

Любопытно, что как раз эта функция (простите за каламбур), похоже, свою функцию не выполняет.

[Serge_Bliznykov]

Сообщение от s-andriano

Любопытно, что как раз эта функция (простите за каламбур), похоже, свою функцию не выполняет.

АА! Точно! Это я прокосячил.
Тестировал и забыл её в коде. Она, разумеется, в данном примере не нужна (я уже убрал её из своего примера), и нигде не вызывается..

Приношу извинения за свою невнимательность.