algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Zamiana z i na system rzymski - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 5
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 09 lutego 2007 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

Rzymskie Delphi/rzymskie.dpr:
//Konwersja liczby arabskie <-> rzymskie
//www.algorytm.org
//(c)2006 Tomasz Lubinski
program rzymskie;
{$APPTYPE CONSOLE}
uses SysUtils;

const ROMAN_N = 7;
arabic: Array[0..ROMAN_N-1] of Integer = (1000, 500, 100, 50, 10, 5, 1);
roman: Array[0..ROMAN_N-1] of String = ('M', 'D', 'C', 'L', 'X', 'V', 'I');


// Converts arabic <number> to roman <result>
// Returns <result> or '', if an ERROR occurs.
function arabic2roman(number: Integer): String;
var
    i: Integer; //position in arabic and roman arrays
begin
    i := 0;
    result := '';

    if ((number > 3999) or (number <= 0)) then
    begin
        exit;
    end;

    while ((number > 0) and (i < ROMAN_N)) do
    begin
        if(number >= arabic[i]) then
          begin
            number := number - arabic[i];
            result := result + roman[i];
          end
        else if ((i mod 2 = 0) and
                 (i<ROMAN_N-2) and // 9xx condition
                 (number >= arabic[i] - arabic[i+2]) and
                 (arabic[i+2] <> arabic[i] - arabic[i+2])) then
          begin
            number := number - (arabic[i] - arabic[i+2]);
            result := result + roman[i+2] + roman[i];
            i := i+1;
          end
        else if ((i mod 2 = 1) and
                 (i<ROMAN_N-1) and //4xx condition
                 (number >= arabic[i] - arabic[i+1]) and
                 (arabic[i+1] <> arabic[i] - arabic[i+1])) then
          begin
            number := number - (arabic[i] - arabic[i+1]);
            result := roman[i+1] + roman[i];
            i := i+1;
          end
        else
          begin
            i := i+1;
          end;
    end;

end;

// Converts roman <number> to arabic
// Returns <result> or -1, if an ERROR occurs.
function roman2arabic(number: String): Integer;
var
    i : Integer; //position in arabic and roman arrays
    j : Integer; //position in number
    len : Integer;
begin
    i := 0;
    j := 1;
    len := Length(number);
    result := 0;

    while ((j<=len) and (i<ROMAN_N)) do
    begin
        if(number[j] = roman[i]) then
          begin
            result := result + arabic[i];
            j := j + 1;
          end
        else if ((i mod 2 = 0) and
                 (i<ROMAN_N-2) and // 9xx condition
                 (j<=len-1) and
                 (number[j] = roman[i+2]) and
                 (number[j+1] = roman[i])) then
          begin
            result := result + (arabic[i] - arabic[i+2]);
            j := j + 2;
            i := i + 1;
          end
        else if ((i mod 2 = 1) and
                 (i<ROMAN_N-1) and //4xx condition
                 (j<=len-1) and
                 (number[j] = roman[i+1]) and
                 (number[j+1] = roman[i])) then
          begin
            result := result + (arabic[i] - arabic[i+1]);
            j := j + 2;
            i := i + 1;
          end
        else
          begin
            i := i + 1;
          end;
    end;

    //there was an error during conversion
    if (i = ROMAN_N) then
    begin
       result := -1;
    end;

end;

var
rom : String;
begin

   rom := arabic2roman(1981);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(1);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(3);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(4);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(5);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(6);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(45);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);
   rom := arabic2roman(68);
   writeln(IntToStr(roman2arabic(rom)) + ' = ' +  rom);

   readln;

end.
Dodaj komentarz