IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Перевод из Q-ичной в P-q-ичную с. с.
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 19
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Сколько программ перевода в разные системы счисления я видел, и стандартные: 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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


Новичок
*

Группа: Пользователи
Сообщений: 19
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Цитата(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.

Сообщение отредактировано: /7popok -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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

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

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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 19
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Я бы не спрашивал, если всё так просто. Всё правильно в примере у меня. Число 33 в десятичной системе счисления - это 110011 в двоично-десятичной. конечно, не мне объяснять вам, програмистам, как переводятся числа, но у меня всё правильно. могу даже алгоритм расписать, если не верите.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Профи
****

Группа: Пользователи
Сообщений: 705
Пол: Мужской

Репутация: -  20  +


klem4, не в двочную, а в двоично-десятичную, т.е. каждый разряд по очереди переводить.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 19
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


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


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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

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


Новичок
*

Группа: Пользователи
Сообщений: 19
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Спасибо вам, люди, за подсказку, дальше я уже всё написал! С отрицательными числами на самом деле нет ничего страшного. Да и 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 30.09.2020 7:42
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name