algorytm.org

Implementacja w Ada



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 Ada
Ocena użytkownikóww: *****  / 3
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.adb:
-- Konwersja liczby arabskie <-> rzymskie
-- www.algorytm.org
-- (c)2007 Tomasz Lubinski

with Text_IO;
use Text_IO;

procedure rzymskie is

arabic : array (natural range <>) of Integer := (1000, 500, 100, 50, 10, 5, 1);
roman : array (natural range <>) of Character := ('M', 'D', 'C', 'L', 'X', 'V', 'I');


-- Converts arabic <number> to roman <result>
-- Returns <result> or "", if an ERROR occurs.
function arabic2roman(numberParam: Integer) return String is

    i: Integer := 0; -- position in arabic and roman arrays
    j: Integer := 0; -- position in result
    result : String (1..100);
    number : Integer := numberParam;
begin

    if (number > 3999) or else
       (number <= 0) then
        return "";
    end if;

    while (number > 0) and then
          (i <= roman'last) loop

        if(number >= arabic(i)) then
            number := number - arabic(i);
            j := j+1;
            result(j) := roman(i);
        elsif (i mod 2 = 0) and then
              (i<roman'last-1) and then -- 9xx condition
              (number >= arabic(i) - arabic(i+2)) and then
              (arabic(i+2) /= arabic(i) - arabic(i+2)) then
            number := number - (arabic(i) - arabic(i+2));
            j := j+1;
            result(j) := roman(i+2);
            j := j+1;
            result(j) := roman(i);
            i := i+1;
        elsif (i mod 2 = 1) and then
                (i<roman'last) and then -- 4xx condition
                (number >= arabic(i) - arabic(i+1)) and then
                (arabic(i+1) /= arabic(i) - arabic(i+1)) then
            number := number - (arabic(i) - arabic(i+1));
            j := j+1;
            result(j) := roman(i+1);
            j := j+1;
            result(j) := roman(i);
            i := i+1;
        else
            i := i+1;
        end if;
        
    end loop;
    
    return result(1..j);
end;

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

    while (j<=number'last) and then
          (i<=roman'last) loop

        if (number(j) = roman(i)) then
            result := result + arabic(i);
            j := j+1;
        elsif (i mod 2 = 0) and then
              (i<roman'last-1) and then -- 9xx condition
              (j<number'last) and then
              (number(j) = roman(i+2)) and then
              (number(j+1) = roman(i)) then
            result := result + arabic(i) - arabic(i+2);
            j := j+2;
            i := i+1;
        elsif (i mod 2 = 1) and then
              (i<roman'last) and then -- 4xx condition
              (j<number'last) and then
              (number(j) = roman(i+1)) and then
              (number(j+1) = roman(i)) then
            result := result + arabic(i) - arabic(i+1);
            j := j+2;
            i := i+1;
        else
            i := i+1;
        end if;
    
    end loop;

    -- there was an error during conversion
    if (i = roman'last + 1) then
       result := -1;
    end if;

    return result;
end;

roman1: String := arabic2roman(1981);
roman2: String := arabic2roman(1);
roman3: String := arabic2roman(3);
roman4: String := arabic2roman(4);
roman5: String := arabic2roman(5);
roman6: String := arabic2roman(6);
roman7: String := arabic2roman(45);
roman8: String := arabic2roman(68);

begin

   Put_Line( Integer'Image(roman2arabic(roman1)) & " = " & roman1);
   Put_Line( Integer'Image(roman2arabic(roman2)) & " = " & roman2);
   Put_Line( Integer'Image(roman2arabic(roman3)) & " = " & roman3);
   Put_Line( Integer'Image(roman2arabic(roman4)) & " = " & roman4);
   Put_Line( Integer'Image(roman2arabic(roman5)) & " = " & roman5);
   Put_Line( Integer'Image(roman2arabic(roman6)) & " = " & roman6);
   Put_Line( Integer'Image(roman2arabic(roman7)) & " = " & roman7);
   Put_Line( Integer'Image(roman2arabic(roman8)) & " = " & roman8);                   
   
end;
Dodaj komentarz