Перевод из 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

[/7popok]

Спасибо вам, люди, за подсказку, дальше я уже всё написал! С отрицательными числами на самом деле нет ничего страшного. Да и 0 он не выводил, если вводишь начальное значение 0. Теперь со всем этим мозготрёпки нет. Если кому интересно, то вот он весь код от начала и до конца без описания функций FromDec и ToDec.

uses crt;
function zeroes(s: string; n: integer): string;
begin
  while length(s) < n do s := '0' + s;
  zeroes := s
end;
function power(a, b: integer): longint;
var i, X: longint;
begin
  X := 1;
  for i := 1 to b do
    X := X * a;
  power := X;
end;
var get_bits,num,num1,i,p,q,t:integer;
    s_num,s_res,conv:string;
begin
clrscr;
    write('P = '); readln(p);
    write('Q = '); readln(q);
    if q>10 then
       begin
         writeln('q должно быть меньше 10');
         readln;
         halt;
       end;
    if (p>=q)or(not(p>1))or(not(q>2)) then
       begin
         writeln('q должно быть больше p, а p>1');
         readln;
         halt;
       end;
    write('x = '); readln(num);
  num1:=abs(num);
  get_bits:=0;
  while power(p, get_bits) < q do inc(get_bits);
  {writeln('get_bits = ', get_bits);}
  for i:=1 to get_bits do
   begin
     t:=num-trunc(num/10)*10;
    if t>=q then
     begin
       writeln('Все цифры должны быть меньше основания');
       readln;
       halt;
     end;
   end;
  str(num1, s_num);
  s_res := '';
  for i := 1 to length(s_num) do
      s_res:=s_res+zeroes(fromdec(todec(s_num[i],q),p),get_bits);
  while (length(s_res) > 0) and (s_res[1] = '0') do delete(s_res, 1, 1);
  if num<0 then writeln('x=','-',s_res);
  if num=0 then writeln('x=','0');
  if num>0 then writeln(s_res);
readln;
end.

P.S. Привожу систему тестов. Всё работало правильно.
№__P__Q__Вводимое число___Результат_______________Примечания______________ Вид теста
1__2___10_33_______________110011_________________Начальный тест___________Нормальные условия
2__3___9__121______________10201__________________Начальный тест
3__4___8__222______________20202__________________Начальный тест
4__2___8__-73______________-111011________________Отрицательное число
5__3___9__0________________0______________________Нулевой тест_____________Экстремальные условия
6__2___10_20000____________100000000000000000_____Большое число
7__2___3__495______________Сообщение об ошибке____Неверные данные_________Исключительные условия
8__4___8__asd______________Сообщение об ошибке____Неверные данные
9__4___10_#$%@____________Сообщение об ошибке____Неверные данные
10_6___9__232.454___________Сообщение об ошибке____Неверные данные

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