Перевод из Q-ичной в P-q-ичную с. с. Опции

[/7popok]

Сколько программ перевода в разные системы счисления я видел, и стандартные: 2- 8- 10- 16-, и разные другие, даже из римской в 10- и обратно и в троичную уравновешенную и обратно. Но сколько я ни искал, так и не нашёл переводов в системы со смешанным основанием. Попытался написать такое, но получилось наоборот из P-Q-ичной в Q-ичную. Теперь мучаюсь. Не могу сделать то, что хотел... посмотрите, пожалуйста, кому не лень, и подскажите, что не так... легче было простенькую игрушку на 500 строк написать, чем это, честно...

uses crt;
var
 te,i,j,tp,p,q,xk,xkt,code:integer;
 x,tt:real;
 s:string;
{---------------------------------------------------}
 {функция возведения числа I в степень j}
 function stepen ( i,j:integer): integer;
 var
  k :integer;
  s:longint;
 begin
  s:=1;
  if j=0 then stepen:=1;
  for k:=0 to j-1 do
    s:=s*i;
  stepen:=s;
 end;
 {---------------------------------------------------}
 {нахождение количества цифр в разряде}
 procedure Kolvo;
 var
  sn:integer;
 begin
  tp:=1;
  sn:=q-1;
  repeat
   sn:=(sn) div p;
   tp:=tp+1;
  until sn<p;
 end;
{---------------------------------------------------}
begin
clrscr;
{ввод в цикле параметров:
  Число, основание p и q с.с
 в случае некорректного ввода данных на экран выводится сообшение об ошибке,
 ввод данных повторяется }
repeat
 write(' vvedite 4islo: ');
 readln(s);
 te:=1;
 Val(s, x, Code);
 If Code<>0 Then
  begin
   WriteLn('oshibka pri preobrazovanii v pozicii!!! : ', Code);
   te:=0;
  end;
 if x<>trunc(x) then
  begin
   writeln('4islo dolzno bit celim');
   readln;
   te:=0;
  end;
 if te<>0 then
 begin
   write(' vvedite osnovanie p: ');
   readln(p);
   write(' vvedite osnovanie q: ');
   readln(q);
 if q>10 then
  begin
   writeln('Error!!! osnovanie ne bolshe 10');
   readln;
   te:=0;
   end;
 end;
 if te<>0 then
 if (p>=q)or(not(p>1))or(not(q>2)) then
  begin
   writeln('Error!!! nepravilnoe osnovanie!(p>=q)');
   readln;
   te:=0;
  end;
 until te=1;
 {вызов функции подсчета количества цифр в разряде}
 kolvo;
 xk:=0;
 j:=0;
 xk:=0;
 xkt:=0;
 {перевод числа в q c.c}
 Repeat
  {перевод разряда}
  for i:=1 to tp do
   begin
    j:=j+1;
    tt:=x-trunc(x/10)*10;
    if tt>=p then
     begin
       writeln('Error!!! cifra bolshe osnovaniya!');
       readln;
       exit;
     end;
    x:=(x-tt)/10;
    {перевод чисел разряда из p в q}
    xkt:=xkt + trunc(tt)*stepen(p,i-1);
   end;
   {проверка на корректность данных}
   if xkt>=q then
    begin
       writeln('Error!!! nevernoe 4islo!');
       readln;
       exit;
    end;
   {суммирование разрядов в конечное число}
   xk:=xk+ xkt*stepen(10,trunc(j/tp)-1);
   xkt:=0;
 until j>=10;
 writeln;
 {вывод результата на экран}
 writeln('4islo po osnavaneu ',p,'-',q,' = ',xk);
readln;
end.

P.S. Этот код уже с исправлениями частично под то, что я пытался сделать, но на большее меня не хватило.

Сообщение отредактировано: /7popok - 24.01.2007 21:03

[klem4]

В тестовом примере у тебя ошибка (во втором) ..

А решение ... уже давно все решено Общие вопросы по математике.

Для твоих тестов применяется так:

  writeln(FromDec(ToDec('121', 9), 3));
writeln(FromDec(ToDec('33', 10), 2));