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

[volvo]

посмотрите, пожалуйста, кому не лень, и подскажите, что не так...

Угу... Обязательно... Только ты сначала приведи 3-4 примера входных и соответствующих им выходных данных (правильных, разумеется, которые ДОЛЖНЫ получиться)...

[/7popok]

Угу... Обязательно... Только ты сначала приведи 3-4 примера входных и соответствующих им выходных данных (правильных, разумеется, которые ДОЛЖНЫ получиться)...

Входные данные:
p=3, q=9, вводимое значение 121.
Выходные данные:
10201.

Входные данные:
p=2, q=10, вводимое значение 33.
Выходные данные:
110011.

Входные данные:
p=6, q=8, вводимое значение -73.
Выходные данные:
-1021.

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

[klem4]

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

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

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

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

[/7popok]

Я бы не спрашивал, если всё так просто. Всё правильно в примере у меня. Число 33 в десятичной системе счисления - это 110011 в двоично-десятичной. конечно, не мне объяснять вам, програмистам, как переводятся числа, но у меня всё правильно. могу даже алгоритм расписать, если не верите.

[klem4]

Возможно я чего-то не понимаю, но разьве

33 ₁₀ <> 1*2⁰ + 1*2 ⁵ = 100001₂?

[Malice]

klem4, не в двочную, а в двоично-десятичную, т.е. каждый разряд по очереди переводить.

[/7popok]

Основание системы p-q обозначает, что в числах этой с.с. алфавит p-ичной с.с., а при переводе из q-ичной в p-q-ичную с.с. каждый разряд в исходном числе разбивается на N разрядов при условии p^N>q (число N - наименьшее требуемое для выполнения этого условия, и это число целого типа)

[klem4]

klem4, не в двочную, а в двоично-десятичную, т.е. каждый разряд по очереди переводить.

Ок, это я проглядел, в таком случее:

зы Только надо дописать добавление недостающих нулей к каждой четверке разрядов (я сделал просто пробел)

function GETPQ(n, p, q: Integer): String;
var
  res, s: String;
  T: Integer;

begin
  res := '';

    while (n > 0) do begin

    T := n mod 10;
    Str(T, s);

    res := res + FromDec(ToDec(s, p), q) + ' ';

    n := n div 10;
  end;

  GETPQ := res;
end;
//...
writeln(GETPQ(121, 9, 3));
writeln(GETPQ(33, 10, 2));

[добавлено]: А с отрицательными числами всетаки трабла, придется свое сочинать

[volvo]

Я бы сделал вот так (с учетом FromDec/ToDec из FAQ-а):

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
  P, Q: integer;
  get_bits, i, num: integer;

  s_num, s_res, conv: string;

begin
  {
    write('P = '); readln(P);
    write('Q = '); readln(Q);
  }

  p := 3;
  q := 9;
  num := 121;

  get_bits := 0;
  while power(P, get_bits) < Q do inc(get_bits);

  writeln('get_bits = ', get_bits);
  str(num, s_num);

  s_res := '';
  for i := 1 to length(s_num) do begin
    s_res := s_res + zeroes(fromdec(todec(s_num[i], q), p), get_bits);
  end;
  while (length(s_res) > 0) and (s_res[1] = '0') do delete(s_res, 1, 1);
  writeln(s_res)


end.

С отрицательными чуть позже разберусь... Пока не совсем понятен алгоритм...

[/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