задача на системы счисления Опции

[Amro]

Вот тута прогу одну нашёл, правда ещё сам не разобрался, но по-моему она переводит из любой системы счисления в любую другую ....... в общем универсальная она

Код

program perevod;
var
   q,p,n,osnov,s,m,i:longint;
   st:string;
   ch:char;
   mas:array[1..30] of byte;

function test(st:string; osnov:integer):boolean;
var n,i:integer; mn:set of char;
begin
test:=true;
mn:=[];
for i:=0 to osnov-1 do
   if i<=9 then mn:=mn+[chr(i+48)]
      else mn:=mn+[chr(i+55)];
n:=ord(st[0]);
for i:=1 to n do
if (st[i]<>',') and (not(st[i] in mn)) then
   begin
   writeln('Неправильная запись числа. Повторите ввод');
   test:=false;
   i:=n;
   end;
end;

function chislo(ch:char):integer;
begin
if ord(ch) in [48..57] then chislo:=ord(ch)-48
   else chislo:=ord(ch)-55;
end;

function simvol(n:byte):char;
begin
if n in [10..15] then simvol:=chr(n+55)
   else simvol:=chr(n+48);
end;

begin
writeln ('Введите основание р');
readln(p);
writeln ('Введите число (для цифр после 9 писать ABC...)');
repeat
   readln (st);
until test(st,p);
writeln ('В какую систему перевести?');
readln (q);
s:=0;
m:=1;
n:=ord(st[0]);
for i:=n downto 1 do
   begin
   s:=s+chislo(st[i])*m;
   m:=m*p;
   end;
m:=0;
repeat
   inc(m);
   mas[m]:=s mod q;
   s:=s div q;
until s<=q-1;
inc(m);
mas[m]:=s;
for i:=m downto 1 do
   write(simvol(mas[i]));
end.

Прикольная между прочим прога, вроде всё прально делает!!!!

Внимание всем, кто еще раз решит, что эта программа работает с любыми системами счисления!!! Программа корректно переводит числа из любой системы счисления с основанием 2 .. 16 в любую систему счисления с основанием 2 .. 16 !!! Не более того.
НЕ считайте эту программу действительно универсальным переводчиком, и не ждите от нее корректной работы с другими системами счисления!!!

Сообщение отредактировано: volvo - 15.12.2005 12:48

[volvo]

Принцип остается тот же -

здесь...

Код

for i:=n downto 1 do
 begin
 s:=s+chislo(st[i])*m;
 m:=m*p;
 end;

вычисляется 10-ное число...

[GoodWind]

И у меня есть попутный вопрос - ведь наверняка должен быть алгоритм перевода чисел из любой системы в любую минуя десятичную?

завтра ОМТ`шницу нашу спрошу

[Dao]

Я мож и опоздал, но в том году писал прогу, которая переводит числа из десятичной системы счисления в шестнадцатеричную (а может и еще в какую-нить). Так, если кому пригодится

Код

uses crt;
var a : real;
   z,k,q : integer;
   s,m : string;
   c : char;
begin
repeat
write ('Введите дробное число по основанию 10 : ');
readln(a);
write ('Введите новое основание : ');
readln(q);
write ('Введите количество знаков после запятой : ');
readln(z);
k:=0;
s:='0,';
m:='';
a:=a-trunc(a);
while (a>0)and(k<z) do
 begin
  k:=k+1;
  a:=a*q;
  str(trunc(a),m);
  if q=16 then
   begin
    if m='10' then m:='A';
     if m='11' then m:='B';
      if m='12' then m:='C';
       if m='13' then m:='D';
        if m='14' then m:='E';
         if m='15' then m:='F';
   end;
  s:=s+m;
  a:=a-trunc(a);
 end;

writeln ('Число по основанию ',q,' : ',s);
writeln('Будем считать еще? (Д/Н)');
writeln;
c:=readkey;
until (c='y')or(c='Y');
end.

[Altair]

Опоздал во-первых, во-вторых слишком однобокая прога, всего 1 действтие... не оптимально... хотя молодец, задача решена, и это главное!

[Dao]

Полностью с тобой согласен, но 5 у меня уже сотит, а это главное.

[Altair]

Точно!

[Vika]

function FromDec(n, radix:longint):string; {перевод числа n из
radix c/c в 10-ую}
n:=n div radix;

function ToDec(n:string; radix:longint):longint; {перевод числа n из
10-ной с/с в radix}
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1;

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

Сообщение отредактировано: Vika - 22.10.2004 9:29

[Altair]

Не понял, что тебе не нравиться?

[aspu]

А вот я что-то не пойму та прога универсальная на запятую не ругается но с дробями работает неправильно как бы туда еще дроби запихнуть?

[Jill]

ребята, а если ПРОСТО десятичное (и положительное, и отрицательное) в двоичное? что-то по полочкам не раскладывается совсем

проблема именно в ОТРИЦАТЕЛЬНЫХ числах (((

Сообщение отредактировано: Jill - 26.09.2005 15:00

[aspu]

У тебя не проблема При переводе между системами знак не меняется так что просто определяешь знак у исходного числа и добавляешь его к итоговому а вот с дробями это проблема

[Jill]

как это?

добавляешь его к итоговому

по-моему, там происходят изменения в старшем разряде, а не просто меняется знак

разве не так?

[aspu]

A черт его знает в одних источниках одно написано в других другое. Вон виндовый калькулятор вообще при преобразовании туда-обратно фигню выдает какую-то. Полный бред вобщем

[Jill]

виндовый калькулятор вообще при преобразовании туда-обратно фигню выдает какую-то

калькулятор не обрабатывает отр. числа :-)
чтоб получить отр. необходимо перевести модуль числа, провести инверсию (поменять 0 на 1 и наоборот) и прибавить единицу (по-моему, можно в самом калькуляторе)

а вот как это сделать в pascal... :-(

[aspu]

ну вот и меняй Переведи его в строковый вид и по порядку каждую цифирь меняй :rose:

[Гость]

Помогите пожалуйста модифицировать программу перевода для больших целых чисел (>14 разрядов). Использую фукции Mod и т.п, которые только для целых.

var a,b,cc,r:integer;
c,ab,dd:string;

Function sn (a, n: integer): integer;
Var i,s: integer;
Begin
sn := 0;
s := 1;
For i:=1 To n Do
s := s*a;
sn := s;
End;

Procedure make_to_ten (m: String; Var kk: String);
var
i, r : integer;
l : char;
Begin
i := 0;
r := 0;
while i<>length(m) Do
Begin
l := m[length(m)-i]; {отделяем цифру}
If ord(l)<=ord('9') Then
r := r + (ord(l) - ord('0')) * sn (a, i) {для чисел 0,1,..,9}
Else
r := r + (ord(l) - ord('a') + 10) * sn (a, i); {для латинских букв}
i := i + 1;
End;
str (r, kk);
End;
Function intg(d:String): integer;
Var code,res: integer;
Begin
val(d,res,code);
intg := res;
End;

begin
write('Исходная система счисления: ');
readln(a);
write('Итоговая система счисления: ');
readln(b);
write('Число: ');
readln( c );
ab := '';
If b=10 Then make_to_ten(c,ab) {переводим в десятичную СС}
Else
Begin
make_to_ten(c,dd); {переводим в десятичную СС}
cc := intg(dd); {переводим строковую информацию в целочисленную}
while cc>0 Do
Begin
r := cc Mod b; {берем остаток}
cc := cc Div b; {берем целое частное}
If r>=10 Then ab := chr(ord('a')+r-10)+ab
Else ab := chr(48+r)+ab;
End;
End;
writeln ('-----------------------');
writeln ('Итог: ',ab);
readln;
End.