Технический форум

Технический форум (http://www.tehnari.ru/)
-   Помощь студентам (http://www.tehnari.ru/f41/)
-   -   Задача на системы счисления Pascal ABC (http://www.tehnari.ru/f41/t88814/)

Diana95 06.06.2013 18:58

Задача на системы счисления Pascal ABC
 
Здравствуйте, требуется помощь в решении задачи на системы счисления.
Условие задачи: Написать программу, которая выполняет алгебраическое сложение целых положительных и отрицательных двоичных чисел в обратном коде.

Diana95 09.06.2013 19:30

Такое дело, у меня есть задача с таким же условием, но только с выводом в дополнительном коде, требуется помощь с переделкой с обратный.
Вот решение:
program dop_kod;

{Алгебраическое сложение положительных и отрицательных двоичных целых чисел в дополнительных кодах}

uses
CRT, GraphABC;

var
st, st1: string;
ot: string;
zam: string;
r, r1: string;
i: integer;
mn: set of char;
f: boolean;
t, q: integer;



procedure nul(var st1, st: string);// Убираем нули
var
i: integer;
begin
for i := 3 to length(st) do
if st[i] = '0' then
begin
Delete(st, i, 1);
i := 2;
end else break;
for i := 3 to length(st1) do
if st1[i] = '0' then
begin
Delete(st1, i, 1);
i := 2;
end else break;
end;




procedure long(var st1, st: string);// Процедура расчета длины двух чисел
var
i: integer;


begin
// записываем в переменную число без учета знака
if st[2] = '.' then for i := 3 to length(st) do r1 := r1 + st[i] else
for i := 1 to length(st) do r1 := r1 + st[i];
if st1[2] = '.' then for i := 3 to length(st1) do r := r + st1[i] else
for i := 1 to length(st1) do r := r + st1[i];
writeln('Выравнивание кодов:');
if length(r) > length(r1) then begin// если первое число больше второго, то добавляем нули во второе число
while length(r1) < length(r) do r1 := '0' + r1;
st := st[1] + '.' + r1; // добавляем знак к результату
end;

if length(r) < length(r1) then begin// если второе число больше первого, то добавляем нули в первое число
while length(r1) > length(r) do r := '0' + r;
st1 := st1[1] + '.' + r; // добавляем знак к результату
end;
writeln(st);
writeln(st1);
writeln;

end;

procedure zamena(var st, st1: string);//Процедура перевода в дополнительный код
var
i: integer;
p: integer;

begin
p := 0;
zam := '';

if (st[2] = '.') and (st[1] = '1') then // определяем отрицательное ли число или нет
begin
writeln('Число ', st, ' отрицательное');
write('Переводим в обратный код и получаем результат:');
writeln;
// заменяем 1 на 0, 0 на 1
for i := 3 to length(st) do
if st[i] = '1' then zam := zam + '0' else zam := zam + '1';
// прибавляем к обратному коду знак
st := st[1] + st[2] + zam;
writeln(st);
writeln('Получим дополнительный код:');
// выполняем действия до точки
for i := length(st) downto 3 do
begin
if ((StrToInt(st[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
begin
ot := '0' + ot; // записываем 0
if st[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end else // иначе
begin
ot := '1' + ot; // записываем 1
if st[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end;
end;

Delete(st, (length(st) + 1) - length(ot), length(ot));
st := st + ot;
writeln(st);

end else writeln('Число ', st, ' положительное');

zam := '';
p := 0;
ot := '';
writeln;

if (st1[2] = '.') and (st1[1] = '1') then // определяем отрицательное ли число или нет
begin
writeln('Число ', st1, ' отрицательное');
write('Переводим в обратный код и получаем результат:');
writeln;
// заменяем 1 на 0, 0 на 1
for i := 3 to length(st1) do
if st1[i] = '1' then zam := zam + '0' else zam := zam + '1';
// прибавляем к обратному коду знак
st1 := st1[1] + st1[2] + zam;
writeln(st1);
writeln('Получим дополнительный код:');
// выполняем действия до точки
for i := length(st1) downto 3 do
begin
if ((StrToInt(st1[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
begin
ot := '0' + ot; // записываем 0
p := 1; // в остаток 1
end else // иначе
begin
ot := '1' + ot; // записываем 1
if st1[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end;
end;

Delete(st1, (length(st1) + 1) - length(ot), length(ot));
st1 := st1 + ot;
writeln(st1);

end else writeln('Число ', st1, ' положительное');

writeln;
writeln;

end;


procedure sum(var st, st1: string);// процедура сложения двоичных кодов
var
i, j: integer;
p, sum, q: integer;
z1, z2, a, b: string;
rr, tri: string;
begin

writeln(' ' + st);
writeln(' +');
writeln(' ' + st1);
writeln(' ---------');
p := 0; // остаток
ot := '';

// сложение положительного и отрицательного числа
if ((st[1] = '0') and (st1[1] = '1')) or ((st[1] = '1') and (st1[1] = '0')) then

begin
z1 := Copy(st, 1, 2); // знак первого числа
z2 := Copy(st1, 1, 2); // знак второго числа
// удаляем из строк знаки
Delete(st, 1, 2);
Delete(st1, 1, 2);
// делаем строки кратные трем
while length(st) mod 3 <> 0 do st := '0' + st;
while length(st1) mod 3 <> 0 do st1 := '0' + st1;

// переводим первое число в восмиричный код
while length(st) > 0 do
begin
tri := Copy(st, 1, 3); // копируем три символа

case strtoint(tri) of // выбираем
000: b := b + '0';
001: b := b + '1';
010: b := b + '2';
011: b := b + '3';
100: b := b + '4';
101: b := b + '5';
110: b := b + '6';
111: b := b + '7';
end;

Delete(st, 1, 3); // удаляем три символа
end;

a := b;
b := '';
// переводим второе число в восмиричный
while length(st1) > 0 do
begin
tri := Copy(st1, 1, 3);

case strtoint(tri) of
000: b := b + '0';
001: b := b + '1';
010: b := b + '2';
011: b := b + '3';
100: b := b + '4';
101: b := b + '5';
110: b := b + '6';
111: b := b + '7';
end;

Delete(st1, 1, 3);
end;



// убираем нули в начале
for i := 1 to length(a) do
if a[1] = '0' then delete(a, 1, 1) else break;

for i := 1 to length(b) do
if b[1] = '0' then delete(b, 1, 1) else break;

q := StrToInt(a);
p := StrToInt(b);

// определяем знак числа
if z1 = '1.' then q := -q;
if z2 = '1.' then p := -p;

// складываем
sum := q + p;

st := IntToStr(sum);
// если сумма больше 0, значит число положительное
if sum > 0 then ot := '0.' + ot else begin
ot := '1.' + ot;
Delete(st, 1, 1);
end;
// переводим число обратно в двоичный код
for i := 1 to length(st) do
case StrToInt(st[i]) of
0: ot := ot + '000';
1: ot := ot + '001';
2: ot := ot + '010';
3: ot := ot + '011';
4: ot := ot + '100';
5: ot := ot + '101';
6: ot := ot + '110';
7: ot := ot + '111';
end;


TextColor(12);
TextBold;
writeln(' ' + ot); // выводим результат


end else begin

for i := length(st) downto 1 do
if st[i] = '.' then begin
if p = 1 then ot := '.' + IntToStr(p) + ot else
ot := '.' + ot end else
if ((StrToInt(st[i]) + StrToInt(st1[i]) + p) mod 2 = 0) then
// если остаток равен нулю
begin
if StrToInt(st[i]) + StrToInt(st1[i]) + p = 0 then
begin// если сумма равно нулю
// добавляем ноль,иначе...
ot := '0' + ot;
p := 0;
end
else
begin
if StrToInt(st[i]) + StrToInt(st1[i]) + p = 2 then
begin
ot := '0' + ot; // добавляем 1
p := 1; // записываем 1 в остаток
end else
begin
p := 1;
ot := '1' + ot;
end;
end;

end
else
begin
ot := '1' + ot; // добавляем еденица
if StrToInt(st[i]) + StrToInt(st1[i]) + p = 3 then p := 1 else p := 0; // если сумма равно 3 записываем в остаток 1, иначе 0
end;

if (st[1] = '0') and (st1[1] = '0') then ot[1] := '0';
if st[1]='1' then ot[1]:='1';
TextColor(12);
TextBold;
writeln(' ' + ot);
writeln;

end;
end;

// основная программа

begin
// HighVideo;
mn := ['1', '0', '.'];
write('Введите первое число в двоичном коде:');
read(st);
while true do
begin// проверка правильности ввода
q := 0;

if st[1] = '+' then // если введен плюс, заменяем его на двоичный код
begin
Delete(st, 1, 1); // удаляем знак
st := '0.' + st; // вставляем двоичный код
end;

if st[1] = '-' then // если введен минус, заменяем его на двоичный код
begin
Delete(st, 1, 1); // удаляем знак
st := '1.' + st; // вставляем двоичный код
end;

if (st[1] <> '+') and (st[1] <> '-') and (st[2] <> '.') then st := '0.' + st;

for i := 1 to length(st) do
begin// идем по каждому символу

if st[i] = '.' then inc(q); // проверяем количество точек
if q > 1 then // если больше 1, выводим ошибку
begin
q := 0;
writeln('Повторите ввод');
read(st);
f := false;
break;
end;

if (st[i] in mn) then f := true else
// проверка элемента в множестве
// если элемент отсутствует выполняем новый ввод
begin
writeln('Повторите ввод');
read(st);
f := false;
break;
end;
end;

if f then break;
end;


write('Введите второе число в двоичном коде:');
read(st1);

while true do
begin// проверка правильности ввода
q := 0;

if st1[1] = '+' then // если введен плюс, заменяем его на двоичный код
begin
Delete(st1, 1, 1); // удаляем знак
st1 := '0.' + st1; // вставляем двоичный код
end;

if st1[1] = '-' then // если введен минус, заменяем его на двоичный код
begin
Delete(st1, 1, 1); // удаляем знак
st1 := '1.' + st1; // вставляем двоичный код
end;

if (st1[1] <> '+') and (st1[1] <> '-') and (st1[2] <> '.') then st1 := '0.' + st1;

for i := 1 to length(st1) do
begin// идем по каждому символу

if st1[i] = '.' then inc(q); // проверяем количество точек
if q > 1 then // если больше 1, выводим ошибку
begin
q := 0;
writeln('Повторите ввод');
read(st1);
f := false;
break;
end;

if (st1[i] in mn) then f := true else
// проверка элемента в множестве
// если элемент отсутствует выполняем новый ввод
begin
writeln('Повторите ввод');
read(st1);
f := false;
break;
end;
end;

if f then break;
end;



writeln;
Nul(st, st1); // процедура удаления нулей
Long(st, st1); // процедура выравнивание длин
Zamena(st, st1); // преобразовываем в дополнительный код
Sum(st, st1); // процедура сложения двоичных кодов

end.

Diana95 10.06.2013 08:51

а если быть точнее то надо переделать только вот эту подпрограмму:
procedure zamena(var st, st1: string);//Процедура перевода в дополнительный код
var
i: integer;
p: integer;

begin
p := 0;
zam := '';

if (st[2] = '.') and (st[1] = '1') then // определяем отрицательное ли число или нет
begin
writeln('Число ', st, ' отрицательное');
write('Переводим в обратный код и получаем результат:');
writeln;
// заменяем 1 на 0, 0 на 1
for i := 3 to length(st) do
if st[i] = '1' then zam := zam + '0' else zam := zam + '1';
// прибавляем к обратному коду знак
st := st[1] + st[2] + zam;
writeln(st);
writeln('Получим дополнительный код:');
// выполняем действия до точки
for i := length(st) downto 3 do
begin
if ((StrToInt(st[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
begin
ot := '0' + ot; // записываем 0
if st[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end else // иначе
begin
ot := '1' + ot; // записываем 1
if st[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end;
end;

Delete(st, (length(st) + 1) - length(ot), length(ot));
st := st + ot;
writeln(st);

end else writeln('Число ', st, ' положительное');

zam := '';
p := 0;
ot := '';
writeln;

if (st1[2] = '.') and (st1[1] = '1') then // определяем отрицательное ли число или нет
begin
writeln('Число ', st1, ' отрицательное');
write('Переводим в обратный код и получаем результат:');
writeln;
// заменяем 1 на 0, 0 на 1
for i := 3 to length(st1) do
if st1[i] = '1' then zam := zam + '0' else zam := zam + '1';
// прибавляем к обратному коду знак
st1 := st1[1] + st1[2] + zam;
writeln(st1);
writeln('Получим дополнительный код:');
// выполняем действия до точки
for i := length(st1) downto 3 do
begin
if ((StrToInt(st1[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
begin
ot := '0' + ot; // записываем 0
p := 1; // в остаток 1
end else // иначе
begin
ot := '1' + ot; // записываем 1
if st1[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
end;
end;

Delete(st1, (length(st1) + 1) - length(ot), length(ot));
st1 := st1 + ot;
writeln(st1);

end else writeln('Число ', st1, ' положительное');

writeln;
writeln;

end;


Часовой пояс GMT +4, время: 14:41.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.