Системы исчисления, из 10-тичной в другую и наоборот Опции

[Sensitive]

Задание такое: Программа должна преобразовывать 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;

Но не знаю, как реализовать, чтоб полученные числа переводились обратно. Подскажите пожалуйста.

[volvo]

Во-первых, в функции 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 - 9.09.2007 16:23

[Sensitive]

Спасибо, volvo! Из-за пробела у меня и не получалось...и выбило с правильной мысли про обратный перевод. спасибо еще раз!

[Sensitive]

А подскажите плиз каким способом можно сделать блокировку нажатия клавиш. Не знаю как объяснить-так что объясню на примере.
Если переводим в 13-ричную систему исчисления,то при вводе чисел которые нужно перевести должна блокироваться цифра 13. (т.к. она не может быть переведена в 13-ричную сис. исчисления). Не знаю как это можно сделать... И так по каждой системе исчисления.

[мисс_граффити]

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

[volvo]

...
  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;
...

Пойдет?

[Sensitive]

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

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

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

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

потому что число должно не быть именно меньше, а оно не должно быть равно ss.
И спасибо еще раз.

[volvo]

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

{ добавляем переменные: }
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 - 13.09.2007 4:21

[Sensitive]

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

Препод объяснял именно так... что 13 нельзя, а 14 уже можно... вот я начинаю думать-не ошибся ли препод с примером.

[мисс_граффити]

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

[Sensitive]

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

[volvo]

не понимаю как можно сделать

Переходом к длинной арифметике...

В 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.

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

[Sensitive]

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

Сообщение отредактировано: Sensitive - 15.09.2007 19:33

[Sensitive]

Вот сидела разбиралась... потом начала писать функцию обратного перевода 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.

[volvo]

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

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;

[Sensitive]

Огромное спасибо. Я разобралась.

[Archie]

Народ...а как записать число в десятчной записи и птом посчитать количество чисел? пришлите плиз эту прогу - а то я сасем пропан в этом деле.

[Sensitive]

Представляете, препод не принял программу! Типа нельзя использовать модуль такой, а нужно просто работать с типом string. Сижу придумываю как бы его намудрить

[volvo]

Тогда тебе надо реализовывать умножение/деление (а может быть, и сложение/вычитание) в столбик чисел, представленных строками... Насчет вычитания и умножения поиск поможет тебе, уже выкладывалось, а вот насчет деления - не помню...

[fererro_rosher]

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.