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

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

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

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Системы исчисления, из 10-тичной в другую и наоборот
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Задание такое: Программа должна преобразовывать 10 в q и q в 10. q в 10 с помощью полимиальной записи чисел, а 10 в q с помощью алгоритма "Обратное деление". Исходные данные вводить по типу string, результат выводить склеяным стрингом. В теоретических вопросах уже побывала, и всё почитала.
Вот что получилось:
uses crt;

function fromdec(n,osnov:longint):string;
var
s:string;
const
digit:string[16]='0123456789ABCDEF';
begin
s:=' ';
repeat
s:=digit[(n mod osnov)+1]+s;
n:=n div osnov;
until n=0;
fromdec:=s;
end;
var s:string;
i,m,code:integer;
ss:integer;
st,a:array[1..50] of string;
p,b:array[1..50] of integer;
begin
clrscr;
writeln('Vvedite sistemu is4isleniya');
readln(ss);
writeln('Vvedite kol-vo 4isel');
readln(m);
writeln('Vvedite chisla');
for i:=1 to m do
begin
readln(st[i]);
end;
for i:=1 to m do
begin
val(st[i],p[i],code);
end;
for i:=1 to 43 do write('-');writeln;
writeln('|','ishodnie':10,'|','polu4ennie':20,'|');
for i:=1 to 43 do write('-');writeln;
for i:=1 to m do writeln(st[i]:10,fromdec(p[i],ss):20);
for i:=1 to 43 do write('-');writeln;
readln;
end.

Из 10-тичной системы переводит. А мне еще нужно, чтоб получившиеся числа (не в десятичной системе) переводились обратно в десятичную. (как бы сразу и для проверки перевода).
Функцию видела, вот эту:
Function ToDec(n:string; radix:longint):longint;
var m,i:longint;
const digit:string[16]='0123456789ABCDEF';
begin
m:=0;
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1;
ToDec:=m;
end;

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


Гость






Во-первых, в функции FromDec не надо изначально присваивать строке значение пробела. Достаточно пустой строки, иначе обратная конвертация работать не будет:

function fromdec(n,osnov:longint):string;
var s:string;
const
digit: string[16]='0123456789ABCDEF';
begin
s:=''; { <--- Здесь нет пробела ... }
...


ну, а так можно сделать проверку:
for i:=1 to m do writeln(st[i]:10,fromdec(p[i],ss):20, todec(fromdec(p[i], ss), ss):20);


Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Спасибо, volvo! Из-за пробела у меня и не получалось...и выбило с правильной мысли про обратный перевод. спасибо еще раз!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


А подскажите плиз каким способом можно сделать блокировку нажатия клавиш. Не знаю как объяснить-так что объясню на примере.
Если переводим в 13-ричную систему исчисления,то при вводе чисел которые нужно перевести должна блокироваться цифра 13. (т.к. она не может быть переведена в 13-ричную сис. исчисления). Не знаю как это можно сделать... wacko.gif И так по каждой системе исчисления.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

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


цифры 13, к сожалению, нет...
обычно идет 1 2 .. 9 А В С ...
так что что блокировать - непонятно. недопустимые буквы?


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






...
writeln('Vvedite sistemu is4isleniya');
readln(ss);
writeln('Vvedite kol-vo 4isel');
readln(m);
writeln('Vvedite chisla');
for i:=1 to m do
begin
repeat
writeln('enter number #', i, ': [1 .. ', ss, ']');
readln(st[i]);
val(st[i], p[i], code); { Заодно и преобразование в том же цикле }
until (code = 0) and (p[i] < ss);
end;
...

Пойдет?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


мм...просто я привела пример,который нам приводил преподаватель...
Да, должно блокировать недопустимые буквы... как я поняла, блокируется вводимая с клавиатуры пользователем буква, которая не может быть переведена в данную систему исчисления(которую так же перед воодом чисел ввел пользователь).

Добавлено через 5 мин.
Volvo, я даже не думала о такой блокировке. Это идея smile.gif Я думала каким-то образом через case нужно будет мудрить... но я думаю так очень даже подойдет. Спасибо. Мне это очень подходит,а вот преподу-посмотрим.
Спасибо.

Добавлено через 7 мин.
Только должно быть

until (code = 0) and (p[i] <> ss);

потому что число должно не быть именно меньше, а оно не должно быть равно ss.
И спасибо еще раз.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Ну, с учетом исправления (относительно букв), это может выглядеть несколько иначе:

{ добавляем переменные: }
var
count, position: integer;
s: string;

{ Это - "алфавит" систем счисления }
const
alpha: string = '0123456789ABCDEFGHIJKLMNOPQSRTUVWXYZ';

writeln('Vvedite sistemu is4isleniya');
readln(ss);
writeln('Vvedite kol-vo 4isel');
readln(m);
writeln('Vvedite chisla');
for i:=1 to m do begin
repeat
count := 0; { считаем, сколько введенных символов попадают в алфавите ДО номера с/с }
writeln('enter number #', i);
readln(s);
for j := 1 to length(s) do begin
position := pred(pos(upcase(s[j]), alpha));
if (position < ss) and (position > 0) then inc(count);
end;
until count = length(s); { если все символы - допустимы, то выходим }
st[i] := s; { и запоминаем введенную строку }
end;
...


Добавлено через 1 мин.
Цитата
потому что число должно не быть именно меньше, а оно не должно быть равно ss.
То есть 13 тебе нельзя переводить, а 14 - можно? Странно... Обычно именно меньше...

Update:
Чтобы не было разночтений: вводится строка, и проверяется на наличие в ней "запрещенных" для заданной системы счисления символов: для с/с с основанием 16 разрешены символы '0' .. 'F', для с/с с основанием 18 - символы '0' .. 'H', для с/с с основанием 7 - символы '0' .. '6'.

Попытка ввести основание с/с = 7 и строку 128, к примеру, будет считаться ошибкой ввода, ибо "8" недопустимо при основании = 7... То же самое произойдет при попытке ввода основания = 16 и строки 12FK, "K" - это перебор...

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Цитата
То есть 13 тебе нельзя переводить, а 14 - можно? Странно... Обычно именно меньше...

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


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

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


а почему, собственно, 13 нельзя перевести в 13сс?
Если его рассматривать как _число_ - никаких проблем вроде нет. Если как _цифру_ - надо полностью менять "алфавит"...


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


А как нужно переделать программу, чтоб она могла обрабатывать вводимое число длинной 255 символов?
Я то понимаю, что нужно работать с типом стринг, но в процедуре перевода ведь longint. По форуму поискала, но так и не нашла, и не понимаю как можно сделать... если сможете помогите пожалуйста.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Цитата
не понимаю как можно сделать
Переходом к длинной арифметике...

В Drkb есть модуль hugeints для работы с длинными целыми... С его помощью функция перевода числа заданного строкой в другую систему счисления выглядит примерно так:

uses hugeints;

function FromDec(n: string; radix:longint):string;
var
s, s_mod, s_div: string;
h_div, h_mod,
h_n, h_radix: hugeint;

code, i_mod: integer;

const
digit: string[16] = '0123456789ABCDEF';

begin
fillchar(h_n, sizeof(h_n), 0);
string2hugeint(n, h_n);
integer2hugeint(radix, h_radix);

s := '';
repeat
hugeint_mod(h_n, h_radix, h_mod);
hugeint2string(h_mod, s_mod);
val(s_mod, i_mod, code);
s := digit[i_mod + 1] + s;
hugeint_div(h_n, h_radix, h_n);
until hugeint_zero(h_n);
FromDec := s;
end;

var r: string;
begin
r := fromdec('5234567890', 16);
writeln('result = ', r);
end.


Не правда ли, не очень сильно отличается от изначального варианта? Зато реализует то, что тебе нужно... Кстати, этот вариант еще далеко не окончательный, я просто оставил модуль без изменений. А если заменить процедуры преобразования типов на функции, то все будет еще проще...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Volvo,спасибо за помощь. Буду разбираться с модулем-не совсем всё понятно...но я постараюсь:)

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


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Вот сидела разбиралась... потом начала писать функцию обратного перевода ToDec.
Вот что получилось...посмотрите плиз где ошибка, не переводит правильно...

uses crt,hugeints;

Function ToDec(n:string; radix:longint):string;
var s_m,s_position,s_mul:string;
h_n, h_radix,h_mul,h_position,h_m: hugeint;
i,position,m:longint;
const digit:string[16]='0123456789ABCDEF';
begin
fillchar(h_n, sizeof(h_n), 0);
integer2hugeint(radix, h_radix);
m:=0;
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
for i:=1 to length(n) do position:=pos(n[i],digit)-1;
integer2hugeint(position,h_position);
integer2hugeint(m,h_m);
hugeint_mul(h_m,h_radix,h_mul);
HugeInt_Add(h_mul,h_position,h_m);
hugeint2string(h_m,s_m);
ToDec:=s_m;
end;
var r,s,d: string;
ss:longint;
begin
clrscr;
writeln('Vvedite sistemu is4isleniya:');
readln(ss);
writeln('Vvedite 4islo:');
readln(s);
r := fromdec(s, ss);
writeln('result = ', r);
d:=todec(r,ss);
writeln('result = ', d);
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Совсем не обязательно делать в цикле то, что можно сделать один раз - перед циклом:

function ToDec(n:string; radix:longint):string;
var
m, i: longint;
h_m, h_radix, h_sum: hugeint;
_result: string;
const
digit: string[16]='0123456789ABCDEF';
begin
m := 0;
fillchar(h_m, sizeof(h_m), 0);
integer2hugeint(m, h_m);
integer2hugeint(radix, h_radix);

while (n[1]='0') and (length(n) > 1) do delete(n,1,1);

for i:=1 to length(n) do begin
hugeint_mul(h_m, h_radix, h_m);
integer2hugeint(pos(n[i], digit) - 1, h_sum);
hugeint_add(h_m, h_sum, h_m);

end;
hugeint2string(h_m, _result);
ToDec := _result;
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Огромное спасибо. Я разобралась.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Новичок
*

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

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


Народ...а как записать число в десятчной записи и птом посчитать количество чисел? пришлите плиз эту прогу - а то я сасем пропан в этом деле.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Пионер
**

Группа: Пользователи
Сообщений: 132
Пол: Женский
Реальное имя: Юлия

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


Представляете, препод не принял программу! Типа нельзя использовать модуль такой, а нужно просто работать с типом string. Сижу придумываю как бы его намудрить smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






smile.gif Тогда тебе надо реализовывать умножение/деление (а может быть, и сложение/вычитание) в столбик чисел, представленных строками... Насчет вычитания и умножения поиск поможет тебе, уже выкладывалось, а вот насчет деления - не помню...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Гость






a kak wam moya programma dlya perewoda chisler d 10-oj d lyubuyu sistemu? 4erez string i putem deleniya ....
Program name;
Uses Crt;
Label ex,pp,ppp,ex2,ex3,pp2,ppp2;
Var
i,ii,j,n,m,mm,b,chislo_new,ostatok,celoe,prob:longint;
error:integer;
flag,flag2,razmer:byte;
chislo,s_celoe,sceloe,s_ostatok,sfor_array,for_array,p_chislo:string;
aa,a:array [1..190] of longint;
simvol:string[2];
wwod_simvola:char;

BEGIN
Clrscr;
Textcolor (13); Write ('В какую систему перевести: ');
Textcolor (10); Readln (razmer);
Textcolor (13); Writeln ('Введите число в 10-ой системе: ');
Textcolor (10); chislo:='';
Repeat
wwod_simvola:=readkey;
i:=ord(wwod_simvola);
Case wwod_simvola of
'0': ii:=0; '1': ii:=1; '2': ii:=2; '3': ii:=3; '4': ii:=4; '5': ii:=5;
'6': ii:=6; '7': ii:=7; '8': ii:=8; '9': ii:=9; 'a': ii:=10; 'A': ii:=10;
'b': ii:=11; 'B': ii:=11; 'c': ii:=12; 'C': ii:=12; 'd': ii:=13;
'D': ii:=13; 'e': ii:=14; 'E': ii:=14; 'f': ii:=15; 'F': ii:=15; end;
if i=13 then goto ex3;
if ii<=10 then begin
Write (wwod_simvola);
chislo:=chislo+wwod_simvola;
end;
ex3:
until i=13;

if razmer<=9
THEN Begin
n:=ord(chislo[0]); sceloe:=''; flag:=0; flag2:=flag;
chislo_new:=razmer+2; ostatok:=razmer+2; i:=1; ii:=1;
While chislo_new>=razmer do begin
While ostatok>=razmer do begin
for j:=1 to n do val(chislo[j],a[j],error);
if a[i]<razmer then begin
sfor_array:='';
for j:=1 to 2 do begin
str(a[j],for_array);
sfor_array:=sfor_array+for_array;
end;
val(sfor_array,b,error);
inc(i);
flag2:=1;
end
else begin b:=a[i]; flag:=1; end;
celoe:=b div razmer; str(celoe,s_celoe);
ostatok:=b mod razmer; str(ostatok,s_ostatok);
sceloe:=sceloe+s_celoe;
p_chislo:=chislo;
delete(p_chislo,1,i);
prob:=ord(p_chislo[0]);
if prob<=0 then begin
if(flag=1) and (ostatok<razmer) then begin flag:=0; goto ex; end;
if(flag2=1) and (ostatok<razmer) then begin chislo:=sceloe;
flag2:=0;
goto ex;
end;
end;
if s_ostatok='0' then s_ostatok:='';
chislo:=s_ostatok;
chislo:=chislo+p_chislo;
i:=1;
n:=ord(chislo[0]);
if n>5 then begin
ostatok:=razmer*2;
goto ppp;
end;
val(chislo,ostatok,error);
ppp:
end;
ex:
aa[ii]:=ostatok;
inc(ii);
s_ostatok:=''; ostatok:=razmer+2;
m:=ord(sceloe[0]);
if m>5 then begin
chislo_new:=razmer*razmer;
goto pp;
end;
val(sceloe,chislo_new,error);
pp:
chislo:=sceloe;
sceloe:='';i:=1;
end;
val(chislo,b,error);
aa[ii]:=b;
end
ELSE Begin
n:=ord(chislo[0]); sceloe:=''; flag:=0; flag2:=flag;
chislo_new:=razmer+2; ostatok:=razmer+2; i:=1; ii:=1;

While chislo_new>=razmer do begin
While ostatok>=razmer do begin
n:=ord(chislo[0]);
for j:=1 to n do val(chislo[j],a[j],error);
if a[i]<razmer then begin
sfor_array:='';
for j:=1 to 2 do begin
str(a[j],for_array);
sfor_array:=sfor_array+for_array;
end;
val(sfor_array,b,error);
inc(i);
flag2:=1;
end;
if b<razmer then begin
sfor_array:='';
for j:=1 to 3 do begin
str(a[j],for_array);
sfor_array:=sfor_array+for_array;
end;
val(sfor_array,b,error);
inc(i);
flag:=1;
end;
celoe:=b div razmer; str(celoe,s_celoe);
ostatok:=b mod razmer; str(ostatok,s_ostatok);
sceloe:=sceloe+s_celoe;
p_chislo:=chislo;
delete(p_chislo,1,i);
prob:=ord(p_chislo[0]);
if prob<=0 then begin
if(flag=1) and (ostatok<razmer) then begin flag:=0; goto ex2; end;
if(flag2=1) and (ostatok<razmer) then begin chislo:=sceloe;
flag2:=0;
goto ex2;
end;
end;
if s_ostatok='0' then s_ostatok:='';
chislo:=s_ostatok;
chislo:=chislo+p_chislo;
i:=1;
n:=ord(chislo[0]);
if n>5 then begin
ostatok:=razmer*2;
goto ppp2;
end;
val(chislo,ostatok,error);
ppp2:
end;
ex2:
aa[ii]:=ostatok;
inc(ii);
s_ostatok:=''; ostatok:=razmer+2;
m:=ord(sceloe[0]);
if m>5 then begin
chislo_new:=razmer*razmer;
goto pp2;
end;
val(sceloe,chislo_new,error);
pp2:
chislo:=sceloe;
sceloe:='';i:=1;
end;
val(chislo,b,error);
aa[ii]:=b; end;

for i:=1 to ii do a[i]:=aa[i];
Writeln; Textcolor (13);
Writeln ('Предложенное Вами число в ',razmer,'-ой системе выглядит сл.образом: ');
Textcolor (10);
for i:=ii downto 1 do
begin
Case a[i] of
10: simvol:='A';
11: simvol:='B';
12: simvol:='C';
13: simvol:='D';
14: simvol:='E';
15: simvol:='F';
0: simvol:='0';
1: simvol:='1';
2: simvol:='2';
3: simvol:='3';
4: simvol:='4';
5: simvol:='5';
6: simvol:='6';
7: simvol:='7';
8: simvol:='8';
9: simvol:='9';
end;
Write (simvol);
delay (10000);
end;
readkey;
end.
 К началу страницы 
+ Ответить 

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

 





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