помогите решить 2 задачи

[Pashtet]

1. дана последовательность символов. ввод символов заканчивается точкой (ноль не используется). если введены все числа с 1 до 9, то вывести 0; если нет то наименьшее число из не использовавшихся.
пример: входные данные-z1d5R8D4 выводимое число-23679.
2. написать программу для сложения двух чисел, записанных в римской системе счисления. результат сложения - в римской системе счисления. контроль корректности входных данных требуется (что писать надо не XXXIX, а IL). результат сложения не может быть больше 3000. пример: XCIC+XLVI=CILV.
Натуральные числа записываются при помощи повторения римских цифр. При этом, если большая цифра стоит перед меньшей, то они складываются (принцип сложения), если же меньшая — перед большей, то меньшая вычитается из большей (принцип вычитания). Последнее правило применяется только во избежание четырёхкратного повторения одной и той же цифры.
ps по 1 задаче: отсеял буквы от чисел, получил строку из чисел, а дальше незнаю как делать...
по 2 задаче-неохота все 2999 переменных описывать, а ниче больше в голову не приходит... HELP! Всем откликнувшимся заранее спасибо!

[Serge_Bliznykov]

вот, две разные программки по преобразованию арабских чисел в римские и обратно...
сложение и нужные проверки допишите сами...
первая:

{Источник: "Наука и жизнь" N12 1986  cтр. 95 }
{Алгоритм: В. Птицын г.Москва }
type str2 = string[2];
   
const
   Rims : array[1..14] of str2 = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I',' ');
   Arab : array[1..14] 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 : integer;
  begin
    I:=1; N := 0;
    while S<>'' do begin
      while Rims[I] = Copy(S, 1, Length(Rims[I]) ) do begin
        S := Copy( S, 1+Length(Rims[I]), 255);
        N := N + Arab[I]
      end;
      I:=I+1
    end;
    Rim2Arab := N
  end;

begin
  WriteLn('Перевод из арабских цифр в римские. 1999 B_SA');
{  Write('Введите число для преобразования:'); ReadLn(N);}
  for NI := 26 to 46 do
    WriteLn(NI,' = ',Arab2Rim(NI),' обратно ', Rim2Arab( Arab2Rim(NI) ));
end.

вторая:

{Перевод из арабской в римскую систему и наоборот

Алгоритм весьма прост и извлекается непосредственно из исходника.
}

{ Copyright MM Andrew Usachov }

const

  R: array[1..13] of string[2] =
  ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');

  A: array[1..13] of Integer =
  (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

function Roman(N: Integer): string;
var Result: string;
  i: Integer;
begin
  Result := '';
  i := 13;
  while N > 0 do
  begin
    while A[i] > N do Dec(i);
    Result := Result + R[i];
    Dec(N, A[i]);
  end;

  Roman := Result;

end;

function Arabic(S: string): Integer;
var Result: Integer;
  i, p: Integer;
begin
  Arabic := -1;
  Result := 0;
  i := 13;
  p := 1;
  while p <= Length(S) do
  begin
    while Copy(S, p, Length(R[i])) <> R[i] do
    begin
      Dec(i);
      if i = 0 then Exit;
    end;
    Result := Result + A[i];
    p := p + Length(R[i]);
  end;
  if Roman(Result) = S then Arabic := Result
end;

var N, Err: Integer;
  S: string;
begin
  repeat
    ReadLn(S);
    if S = '' then Break;
    Val(S, N, Err);
    if Err = 0 then
      WriteLn(Roman(N))
    else
      WriteLn(Arabic(S));
  until false;
end.

[Pashtet]

спасибо, Serge_Bliznykov. но приведенные Вами программы работают чуток не так, как мне надо. здесь http://www.lectureroom.net/885.html находится исходник, который поправить было легче... 2 задача решена!

(******************************************
Программа складывает два числа,записанных
в римской системе счисления
******************************************)
program collapse_of_Roman_numbers;
uses crt; {используем, чтобы задействовать очистку экрана}
const
  {римские цифры}
  RomeDigits: array [1..14] of string[2] =
  ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M',' ');
  {числа, соответствующие римским цифрам}
  ArabicNumbers: array [1..14] of integer =
  (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000,0);
var
  arabic, arab1, arab2: integer; {арабские числа}
  rome, rome1, rome2: string; {римские числа}
(*----------------------------------------
Функция перевода арабского числа в римское
----------------------------------------*)
function ArabicToRome (n: integer): string;
var
  i: integer;
  res: string;
begin
  res:='';
  i:=13; {проверяем от больших чисел к меньшим}
  while n>0 do begin
    {находим следующее число, из которого будем формировать римскую цифру}
    while ArabicNumbers[i]>n do
      i:=i-1;
  res:=res+RomeDigits[i];
    n:=n-ArabicNumbers[i];
  end;
  ArabicToRome := res;
end;
(*----------------------------------------
Функция перевода римского числа в арабское.
Возвращает -1, если в исходной строке
(римском числе) присутствуют неверные цифры.
----------------------------------------*)
function RomeToArabic (s: string): integer;
var
  i, j, res: integer;
begin
  res:=0;
  i:=13; {рассматриваем цифры от больших к меньшим}
  {переводим строку в верхний регистр}
  for j:=1 to length(s) do
    s[j]:=UpCase(s[j]);
  j:=1; {текущий символ строки}
  while j<=length(s) do begin
    {ищем следующую римскую цифру - 1 или 2 символа}
  while (copy(s, j, length(RomeDigits[i]))<>RomeDigits[i])and(i>0) do
    i:=i-1;
  {нашли, добавляем число}
  res:=res+ArabicNumbers[i];
  j:=j+length(RomeDigits[i]);
  end;
  {проверка на случай неверного римского числа (в строке были неверные символы)}
  if ArabicToRome(res)=s then
    RomeToArabic:=res
  else
    RomeToArabic:=-1;
end;
{основная программа}
begin
  ClrScr; {очистка экрана}
  writeln('Программа складывает римские числа');
{операции с числами}
  write('Введите 1 римское число: ');
  readln(rome1);
  {перевод числа из римского в арабское}
  if (RomeToArabic(rome1)<>-1) then
   begin
    Writeln(RomeToArabic(rome1));
    arab1:=RomeToArabic(rome1);
   end
   else
   begin
    writeln('В римской записи числа допущены ошибки! Программа завершает работу.');
    exit;
   end;
  write('Введите 2 римское число: ');
  readln(rome2);
  {перевод числа из римского в арабское}
  if (RomeToArabic(rome2)<>-1) then
   begin
    Writeln(RomeToArabic(rome2));
    arab2:=RomeToArabic(rome2);
    {операции с арабскими числами}
    Arabic:=arab1+arab2;
     if Arabic<=3000 then 
      begin
       writeln(rome1,' + ',rome2,' = ',ArabicToRome(arabic)); {вывод ответа в римскими цифрами}
       writeln(arab1,' + ',arab2,' = ',Arabic); {вывод ответа в римскими цифрами}
      end
     else
     begin
     writeln('Cумма чисел больше 3000. Программа завершает работу.');
     exit;
     end;
   end
  else
   begin
    writeln('В римской записи числа допущены ошибки! Программа завершает работу.');
    exit;
   end;
 writeln('Нажмите [Enter] для завершения программы');
 readln;
   end.
end.

Уважаемые форумчане! Прошу подсказать более лаконичную форму написания программы (если таковая имеется).

[Pashtet]

вот, прога, но не могу вставить условие чтобы в (s) цифры шли вразнобой, а не по порядку. HeLp!

program ex1;
var s,p:string;c,i,c1:integer; a1:string[9];b:string;
a:array [1..9]of integer;
begin
readln(s);
c:=Length(s);
a[1]:=0;a[2]:=0;a[3]:=0;a[4]:=0;a[5]:=0;a[6]:=0;a[7]:=0;a[8]:=0;a[9]:=0;
a1[1]:='1';a1[2]:='2';a1[3]:='3';a1[4]:='4';a1[5]:='5';a1[6]:='6';a1[7]:='7';a1[8]:='8';a1[9]:='9';
b:='';
while(c>0)do
begin
i:=1;
while(i<=9)do
begin
if(s[c]=a1[i])then a[i]:=1;
i:=i+1;
end;
c:=c-1;
end;
i:=1;
while(i<=9)do
begin
if(a[i]=0)then
begin
b:=b+a1[i];
end;
i:=i+1;
end;
if(Length(b)=0)then b:='0';
writeln(b);readln;
end.

[Nixond]

Pashtet, правильно ли я понял:
если введены не все цифры, то надо вывести наименьшее число, составленное из всех неиспользованных цифр - так?

если так, то вот возможная реализация:

program solve;
var
  s: string;
  i, slength: integer;
  a: array [1..9] of boolean;
  test: boolean;
begin
  readln(s);
  slength := length(s);
  fillchar(a, sizeof(a), false);
  i := 1;
  repeat
    if s[i] in ['1', '2', '3', '4', '5', '6', '7', '8' , '9'] then
      a[StrToInt(s[i])] := true;
    inc(i);
  until (i > slength) or (s[i] = '.');
  test := false;
  for i := 1 to 9 do
    if not a[i] then
      begin
        test := true;
        write(i);
      end;
  if not test then
    write(0);
  readln;
end.

P.S. ещё ньюанс есть, я не помню входит ли в Turbo Pascal (если в нем надо написать) функция StrToInt...?

если без неё, то можно сделать так:

repeat
    case s[i] of
      '1': a[1] := true;
      '2': a[2] := true;
      '3': a[3] := true;
      '4': a[4] := true;
      '5': a[5] := true;
      '6': a[6] := true;
      '7': a[7] := true;
      '8': a[8] := true;
      '9': a[9] := true;
    end;
    inc(i);
  until (i > slength) or (s[i] = '.');

[Serge_Bliznykov]

case s[i] of
'1': a[1] := true;

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

    if s[i] in ['1', '2', '3', '4', '5', '6', '7', '8' , '9'] then
      a[ord(s[i])-ord('0')] := true;

Всё! без всех этих case... и StrToInt тоже не понадобится...
и работать будет хоть в Pascal, хоть в Дельфи!

[Nixond]

Мда..
спасибо! - что то совсем вылетел из головы ord..(