Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Перевод из Q-ичной в P-q-ичную с. с.

Автор: /7popok 25.01.2007 1:00

Сколько программ перевода в разные системы счисления я видел, и стандартные: 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. Этот код уже с исправлениями частично под то, что я пытался сделать, но на большее меня не хватило.

Автор: volvo 25.01.2007 1:04

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

Автор: /7popok 25.01.2007 2:36

Цитата(volvo @ 25.01.2007 0:04) *

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


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

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

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

Автор: klem4 25.01.2007 2:50

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

А решение ... уже давно все решено http://forum.pascal.net.ru/index.php?showtopic=4535

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

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

Автор: /7popok 25.01.2007 3:08

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

Автор: klem4 25.01.2007 3:18

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

33 10 <> 1*20 + 1*2 5 = 1000012?

Автор: Malice 25.01.2007 3:21

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

Автор: /7popok 25.01.2007 3:30

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

Автор: klem4 25.01.2007 3:54

Цитата
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));




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

Автор: volvo 25.01.2007 4:03

Я бы сделал вот так (с учетом 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 26.01.2007 1:34

Спасибо вам, люди, за подсказку, дальше я уже всё написал! С отрицательными числами на самом деле нет ничего страшного. Да и 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___________Сообщение об ошибке____Неверные данные