[Pascal] Program tłumaczący liczby rzymskie na arabskie

[ct985]

Mam problem z programem tłumaczącym liczby z zapisu rzymskiego na arabski i odwrotnie, nie rozumiem dlaczego nie działa. Czy ktoś mógłby pomóc:)

Kod: Zaznacz cały

program arabskie_rzymskie;
uses crt;

const
        gap =' ';
type
        digit = 0..9;
var
        count, numbers, arabic : 1..2000;
        tysieczne, setne, dziesietne, jednosci : digit;
        roman, wybor1 : string;
        plus, minus, wybor, i : integer;
        a : boolean;


(********************************)
procedure narzymskie;
begin
writeln('Podaj liczb© w zapisie arabskim');

        begin
        read(arabic);
        write(gap);
        tysieczne:= arabic div 1000;
        setne:= arabic div 100;
        dziesietne:= arabic div 10;
        jednosci:= arabic mod 10;

       case tysieczne of
        0: ;
        1: write('M');
        2: write('MM');
        end;

        case setne of
        0: ;
        1: write('C');
        2: write('CC');
        3: write('CCC');
        4: write('CD');
        5: write('D');
        6: write('DC');
        7: write('DCC');
        8: write('DCCC');
        9: write('CM');
        end;


        case dziesietne of
        0: ;
        1: write('X');
        2: write('XX');
        3: write('XXX');
        4: write('XL');
        5: write('L');
        6: write('LX');
        7: write('LXX');
        8: write('LXXX');
        9: write('XC');
        end;


        case jednosci of
        0: ;
        1: write('I');
        2: write('II');
        3: write('III');
        4: write('IV');
        5: write('V');
        6: write('VI');
        7: write('VII');
        8: write('VIII');
        9: write('IX');
        end;
end;
writeln('Jest to');
readkey;
end;

(*****************************)
procedure naarabskie;

begin
        writeln('Podaj liczby w zapisie rzymskim');
        readln(roman);
        write(gap);
        a := false;

        for i:= 1 to Length(roman) do
        begin
        if a = false then
        begin
        plus:= 0;
        case roman[i] of
                'M' : plus := 1000;
                'D' : plus := 500;
                'C' : plus := 100;
                'L' : plus := 50;
                'X' : plus := 10;
                'V' : plus := 5;
                'I' : plus := 1;
        end;

        case roman[i + 1] of
                'D' : minus := 500;
                'C' : minus := 100;
                'L' : minus := 50;
                'X' : minus := 10;
                'V' : minus := 5;
                'I' : minus := 1;
        end;    {jeľeli liczba poprzedzajĄca jest mniejsza to odejmujemy}
       end;
       if plus < minus then
       begin
       plus := minus - plus;
       a := true;
       end;
       end;

writeln('W zapisie arabskim jest to: ',plus);

end;
(********************************)
BEGIN
Repeat
Clrscr;
Writeln;
Writeln('PROGRAM DO ZAMIANY LICZB ARABSKICH NA RZYMSKIE i odwrotnie');
Writeln('1. arabskie na rzymskie; ');
Writeln('2. rzymskie na arabskie; ');

            readln(wybor);
            if wybor=1 then
                begin
                     narzymskie;
                end;
            if wybor=2 then
                begin
                     naarabskie;
                end;

Writeln('Jeszcze raz? (T) ');
Readln(wybor1);
wybor1:=Upcase(wybor1);
Until wybor1<>'T';
END.

[Piowis]

Jej kilka błędów. Głównie w zamianie na arabskie.
Po pierwsze nigdzie nie sumujesz wcześniej 'obliczonych' wartości, Twój program zawsze zwraca ostatnią pobraną cyfrę (a dokładniej jej wartość w systemie arabskim). Dodaj zmienną, w której będziesz sumował kolejno pobrane 'znaki'.
Niestety kolejnym problemem jest wyjście poza zakres.W pętli for masz 'to Length(roman)', a potem wywołujesz roman[i + 1] i niestety Twój program zagląda do miejsca, w którym są śmieci (na początku), a jeżeli ktoś kilkakrotnie wywoła procedurę naarabskie to będą tam resztki poprzednio pobranego stringa. Musisz albo zmienić sposób obliczania, albo przed sprawdzeniem roman[i + 1] upewnić się, że i <> Length(roman).

Tyle powinno pomóc

[ct985]

Dziękuję bardzo, ale pomimo zmian nadal nie działa i znowu nie rozumiem dlaczego, teraz po zmianie procedury na arabskie zawsze wychodzi jakaś stała liczba ujemna, czy mogę liczyć na jakąś pomoc??

Kod: Zaznacz cały

procedure naarabskie;
var
        suma: integer;

begin
        writeln('Podaj liczby w zapisie rzymskim');
        readln(roman);
        write(gap);
        a := false;

        for i:= 1 to Length(roman) do
        begin
        plus:= 0;
        minus:= 0;
        if (((a = false) and ( i <> Length(roman) ))) then
        begin

        case roman[i] of
                'M' : plus := 1000;
                'D' : plus := 500;
                'C' : plus := 100;
                'L' : plus := 50;
                'X' : plus := 10;
                'V' : plus := 5;
                'I' : plus := 1;
        end;

        case roman[i + 1] of
                'D' : minus := 500;
                'C' : minus := 100;
                'L' : minus := 50;
                'X' : minus := 10;
                'V' : minus := 5;
                'I' : minus := 1;
        end;    {jeľeli liczba poprzedzajĄca jest mniejsza to odejmujemy}
       end;
       if plus < minus then
       begin
       plus := minus - plus;
       a := true;
       suma := suma + plus;
       end
       else a := false;
       end;

writeln('W zapisie arabskim jest to: ',suma);

end;

[Piowis]

Brakuje Ci przed pętlą for suma :=0 to błąd ze strony technicznej. Jednak największym problemem tutaj jest sposób w jaki to robisz. Moja rada to wypróbuj swój program dla:
- XXX (ciąg tych samych znaków)
- I (tylko jeden znak)
No i ogólnie dla każdego ciągu znaków zastanów się czy aby na pewno tą metodą nie pomijasz ostatniego znaku. Innymi słowy, Twój program będzie działał tylko dla bardzo małego zbioru liczb rzymskich. A 'łatanie' tej procedury będzie ciężkie, bo wtedy powstaną kolejne problemy, więc ogólnie radzę wymyślić nowy sposób zamiany Rzymskie->arabskie. Jak coś to pytaj