Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 135 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 45 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 40 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 810
от 16.02.2009, 02:05

Вопрос № 160065: Помогите пожалуйста найти ошибку. Сложение двоичных чисел на Паскале. Результат получается ноль либо строка из 32 цифр. Спасибо. ...

Вопрос № 160.065

Помогите пожалуйста найти ошибку. Сложение двоичных чисел на Паскале. Результат получается ноль либо строка из 32 цифр. Спасибо. Приложение: function IntToBin(bin:longint):string; var bin_s:string; begin bin_s:= ''; if bin=0 then bin_s:='0' else while bin<>0 do begin if (bin and 1)=1 then bin_s:='1'+bin_s else bin_s:='0'+bin_s; bin:=bin shr 1; end; IntToBin:=bin_s end; function BinToInt(bin_s:string): longint; var bin, mult:longint; i:integer; begin mult:=1; bin:=0; for i:=length(bin_s) downto 1 do begin if bin_s='1' then bin:=bin+mult; mult:=mult shl 1; end; end; Function Dec2Bin (num: word): String; var result: string; remainder: word; c: char; begin result := ''; while num <> 0 do begin remainder := num mod 2; num := num div 2; { или num := num shr 1 } c := chr (remainder + ord ('0')); result := c + result; end; end; var BO,BT,BM:word; begin write('Введите первое число: '); readln(BO); write('Введите второе число: '); readln(BT); write('Введите третье число: '); readln(BM); writeln('Результат:',IntToBin(BinToInt(Dec2Bin(BO))-BinToInt(Dec2Bin(BT))+BinToInt(Dec2Bin(BM)))); readln end.

Отправлен: 10.02.2009, 02:18 Вопрос задал: Сиваков Александр (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Сиваков Александр! Программа в приложении. Выполняет суммирование трех двоичных чисел, второе число переводится ещё в дополнительный код. По подпрограммах: inputBin - вводит число в двоичной системе; rangeBin - все введенные числа выравниваются к одному размеру, определенному в разделе констант; convertBin - преводит число в дополнительный код; doSummaBin - суммирование двух двоичных чисел; outputBin вывод результата на экран. Вопросы задавайте в минифорум. Удачи! Приложение: uses crt; const n=32; type TMass=string[n]; var a,b,c:TMass; procedure inputBin(var d:TMass;e:char); begin{inputBin} {вводим число в обратном порядке} write('Enter number',e:2,':'); d:=''; repeat e:=ReadKey;{символ без эхо} if (e='0')or(e='1')then{ноль или единица} begin{begin if} write(e);{выводим его} d:=e+d;{и добавляем в строку} end;{end if} until (e=chr(13))or(length(d)=n);{} writeln; end;{inputBin} procedure outputBin(d:TMass); var i:integer; begin{outputBin} {выводим результат} write('Result :'); {в обратном порядке} for i:=length(d)downto 1 do write(d[i]); writeln; end;{outputBin} procedure doSummaBin(var d,e:Tmass); var f:char; i:integer; begin{doSummaBin} f:='0';{} for i:=1 to length(d) do begin{for} if (e[i]<>d[i])then {обрабатываем ситуацию когда биты различны} begin{ed=10,01} if f='1' then d[i]:='0' {edf=101,011} else d[i]:='1';{edf=100,010} end{10,01} else {обрабатываем ситуацию когда биты одинаковы} begin{ed=00,11} {edf=001,000,111,110} d[i]:=f; f:=e[i]; end;{00,11} end;{for} end;{doSummaBin} procedure rangeBin(var d:Tmass); begin{rangeBin} while length(d)<n do d:=d+'0'; end;{rangeBin} procedure convertBin(var d:TMass;e:TMass); var i:integer; begin{convertBin} for i:=1 to length(d)do {инвертируем биты} case d[i]of{case} '0':d[i]:='1'; '1':d[i]:='0'; end;{case} rangeBin(e);{выравниваем строку} doSummaBin(d,e);{суммируем} end;{convertBin} begin{main} {вводим числа} inputBin(a,'A'); inputBin(b,'B'); inputBin(c,'C'); {выравниваем к одному размеру} rangeBin(a); rangeBin(b); rangeBin(c); {переводим в дополнительный код} convertBin(b,'1'); {суммируем А + Вд + С} doSummaBin(a,b); doSummaBin(a,c); {выводим результат} outputBin(a); ReadKey; end.{main} --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 10.02.2009, 11:44 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243326 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.089

Здравствуйте, уважаемые эксперты! Мне в задаче надо заменить маленькие латинские буквы на прописные (если я ошибусь, то правильно а заменать на А, program на PROGRAM и т. д.) для считывания слова я использую одну переменную а, типа String. а как заменить на большие? и ещё. какая функция извлекает корень из числа? За ответы заранее благодарен.

Отправлен: 10.02.2009, 13:09 Вопрос задал: Хощенко Артём Владимирович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Костя Симанович Здравствуйте, Хощенко Артём Владимирович! Насколько я помню в паскале нет функции которая переводит строчный буквы в прописные и наоборот, поэтому это можно зделать следующим образом, чтобы преобразовать а -> А, достаточно из номера символа вычесть 32, наоборот прибавить 32. оба варианта в приложении. Для сравнения. В задаче использовано множество для проверки на коррекные символы (буквы). Корень квадратный можно извлечь с помощью функции SQRT(x); Удачи. Редактирование: Двойное обращение. -------- ∙ Отредактировал: Зенченко Константин Николаевич, Профессор ∙ Дата редактирования: 10.02.2009, 14:20 (время московское) Приложение: uses crt; var s:string; i:integer; begin clrscr; writeln('Введите строку.'); readln(s); writeln; for i:=1 to length(s) do if s[i] in ['a'..'z'] then begin s[i]:=chr(ord(s[i])-32); end; write(s); readln; end. uses crt; var s:string; i:integer; begin clrscr; writeln('Введите строку.'); readln(s); writeln; for i:=1 to length(s) do if s[i] in ['A'..'Z'] then begin s[i]:=chr(ord(s[i])+32); end; write(s); readln; end.

Ответ отправил: Костя Симанович (статус: 10-й класс) Ответ отправлен: 10.02.2009, 14:12 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243332 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Хоть я Вашим кодом и не воспользовался, всё равно спасибо!

Отвечает: Micren Здравствуйте, Хощенко Артём Владимирович! Программа очень простая. Без комментариев. Приложение: program Pascal_160089; var str:String; i:Integer; begin WriteLn('Enter string:'); ReadLn(str); for i := 1 to Length(str) do str[i]:=UpCase(str[i]); { Upcase() - приводит к верхнему регистру } WriteLn(str); ReadLn; end.

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 10.02.2009, 17:33 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243350 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: cпасибо

Вопрос № 160.130

Нужна помощь в след. задаче: Определить массив Y=X*X-cosX, где X=1.0, 1.2, 1.4, 1.6.....10(шаг 0,2).выделить массив положительных значений Yp и вывести этот массив с сортировкой по возрастанию в 8 колонок.Элементы нечётных колонок заключить в квадратные скобки. Условие правильное. Пожалуйста, кто может помогите.

Отправлен: 10.02.2009, 20:29 Вопрос задал: Volodin Leonid Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Micren Здравствуйте, Volodin Leonid! Вот Ваша программа. В программе используются динамические массивы. Код: program Pascal_160106; const { Начальное значение для X } START_X:Double=1.0; { Конечное значение для X } END_X:Double=10; { Шаг } STEP_X:Double=0.2; type DoublePtr=^Double; var Y,Yp,YPtr,YpPtr,TmpPtr,Min:DoublePtr; X,Size,Tmp:Double; Y_size,Yp_size,i,j,col:Word; begin { Вычисляем размер массива Y } Size:=(END_X-START_X)/STEP_X; Y_size:=Trunc(Size)+1; { Выделяем память } GetMem(Y,SizeOf(Double)*Y_size); { Сохраняем в массив данные и выводим его } WriteLn('Array Y:'); Yp_size:=0; { Считаем положительные } X:=START_X; YPtr:=Y; { Указатель на начало ма ссива } while X<=END_X do begin YPtr^:=X*X-cos(X); X:=X+STEP_X; { Увеличим X на величину шага } if YPtr^>0 then Inc(Yp_size); { Считаем положтительные } Write(YPtr^:7:3,','); Inc(YPtr); { На следующий элемент } end; WriteLn(#8,' '); { Если есть положительные } if Yp_size>0 then begin { Выделяем память для Yp } GetMem(Yp,SizeOf(Double)*Yp_size); YPtr:=Y; YpPtr:=Yp; { Указатели на начало массивов } WriteLn('Disordered Array Yp:'); for i := 1 to Y_size do begin if YPtr^>0 then begin { Заносим положительные в Yp } YpPtr^:=YPtr^; Write(YpPtr^:7:3,','); Inc(YpPtr); { На следующий элемент Yp } end; Inc(YPtr); { На следующий элемент Y } end; WriteLn(#8,' '); { Сортируем массив Yp } YpPtr:=Yp; for i := 1 to Yp_size-1 do begin { Ищем минимальный элемент среди i..Yp_size } TmpPtr:=Yp Ptr; Min:=YpPtr; for j := i+1 to Yp_size do begin Inc(TmpPtr); if YpPtr^>TmpPtr^ then Min:=TmpPtr; end; { Меняем найденный минимальный с i-м } Tmp:=Min^; Min^:=YpPtr^; YpPtr^:=Min^; Inc(YpPtr); { Переходим к следующему } end; { Выводим сортированный Yp } WriteLn('Sorted Array Yp:'); col:=0; YpPtr:=Yp; for i := 1 to Yp_size do begin if not Odd(col) then Write('[',YpPtr^:7:3,'] ') else Write(YpPtr^:7:3,' '); col:=(col+1) mod 8; if col=0 then WriteLn; Inc(YpPtr); end; WriteLn; FreeMem(Yp,SizeOf(Double)*Yp_size); end else WriteLn('No positive values'); FreeMem(Y,SizeOf(Double)*Y_size); ReadLn; end. Результат работы: Код: Array Y: 0.460, 1.078, 1.790, 2.589, 3.467, 4.416, 5.429, 6.497, 7.617, 8.782, 9.990, 11.238, 12.527, 13.857, 15.231, 16.654, 18.130, 19.667, 21.272, 22.953, 24.716, 26.571, 28.525, 30.584, 32.754, 35.040, 37.443, 39.967, 42.610, 45.371, 48.246, 51.232, 54.321, 57.509, 60.786, 64.146, 67.579, 71.079, 74.639, 78.251, 81.911, 85.615, 89.360, 93.145, 96.970,100.839 Disordered Array Yp: 0.460, 1.078, 1.790, 2.589, 3.467, 4.416, 5.429, 6.497, 7.617, 8.782, 9.990, 11.238, 12.527, 13.857, 15.231, 16.654, 18.130, 19.667, 21.272, 22.953, 24.716, 26.571, 28.525, 30.584, 32.754, 35.040, 37.443, 39.967, 42.610, 45.371, 48.246, 51.232, 54.321, 57.509, 60.786, 64.146, 67.579, 71.079, 74.639, 78.251, 81.911, 85.615, 89.360, 93.145, 96.970,100.839 Sorted Array Yp: [ 0.460] 1.078 [ 1.790] 2.589 [ 3.467] 4.416 [ 5.429] 6.497 [ 7.617] 8.782 [ 9.990] 11.238 [ 12.527] 13.857 [ 15.231] 16.654 [ 18.130] 19.667 [ 21.272] 22.953 [ 24.716] 26.571 [ 28.525] 30.584 [ 32.754] 35.040 [ 37.443] 39.967 [ 42.610] 45.371 [ 48.246] 51.232 [ 54.321] 57.509 [ 60.786] 64.146 [ 67.579] 71.079 [ 74.639] 78.251 [ 81.911] 85.615 [ 89.360] 93.145 [ 96.970] 100.839

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 10.02.2009, 20:38 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243355 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.147

Добрый вечер, уважаемые эксперты, мне срочно нужна ваша помошь, в паскале нибумбум).....заранее спасибо! 1) а)Разработать программу для выполнения указанных операций с матрицами - умножение на число, умножение матриц, сложение матриц, транспонирование. б)Разработать программу для вычисления следующей матрицы - (5A-BT)A1. 2)Решить при помощи численных методов уравнение (найти действительные корни) указанным методом: 4x2-16x-47=0 метод бисекции, Ньютона. 3)Написать программу для вычисления определенного интеграла указанным методом: 0.4∫1.21/√0.5x2+2 dx метод Симпсона, прямоугольников

Отправлен: 10.02.2009, 23:58 Вопрос задала: Marino4ka16 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Motoden Здравствуйте, Marino4ka16! Программа, выполняющая пункт (1а) в приложении. Что такое матрица А1 из пункта (1б)? Задавать уточняющие вопросы в ответах запрещено Правилами портала. -------- ∙ Отредактировал: sir Henry, Академик ∙ Дата редактирования: 14.02.2009, 16:42 (время московское) Приложение: program m; uses CRT; type matr=array[1..10,1..10] of real; var i,j,k,z,n:integer; t:real; x:char; a,b,c:matr; procedure vvod_matrix(var n:integer; var matrix1:matr); var ii,jj:integer; begin writeln('Vvedite poryadok matrixi:'); write('n='); readln(n); writeln('Vvedite elementi matrixi:'); for ii:=1 to n do begin for jj:=1 to n do begin write('[',ii,',',jj,']='); readln(matrix1[ii,jj]); end; end; end;{vvod matrixi} procedure vivod_matrix(n:integer; matrix1:matr); var jj,ii:integer; begin ii:=0; while ii<n do begin ii:=ii+1; jj:=0; while jj<n-1 do begin jj:=jj+1; write(matrix1[ii,jj]:3:0); end; jj:=jj+1; writeln(matrix1[ii,jj]:3:0); end; end;{vivod matrixi} begin ClrScr; repeat writeln('Viberite nomer operacii:'); writeln(' 0-transponirovanie matrixi'); writeln(' 1-slojenie matrix'); writeln(' 2-umnojenie matrix'); writeln(' 3-umnojenie matrixi na chislo'); readln(z); case z of 0: begin vvod_matrix(n,A); vivod_matrix(n,A); for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=a[j,i]; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,B); end; 1: begin vvod_matrix(n,A); vivod_matrix(n,A); vvod_matrix(n,B); vivod_matrix(n,B); for i:=1 to n do begin for j:=1 to n do begin c[i,j]:=a[i,j]+b[i,j]; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,c); end; 2: begin vvod_matrix(n,A); vivod_matrix(n,A); vvod_matrix(n,B); vivod_matrix(n,B); for i:=1 to n do begin for j:=1 to n do begin t:=0; for k:=1 to n do begin t:=t+a[i,k]*b[k,j]; end; c[i,j]:=t; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,c); end; 3: begin writeln('Vvedite chislo:'); write('t='); readln(t); vvod_matrix(n,A); vivod_matrix(n,A); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=t*a[i,j]; end; end; writeln; vivod_matrix(n,A); end; end; writeln('Povtor? (y/n)'); x:=readkey; until x=char(ord('n')); end. --------- "это невозможно" - сказала причина, "это болезненно" - сказала гордость, "это безрассудно" - сказал опыт. "Попробуй!" - сказала мечта

Ответ отправил: Motoden (статус: 4-й класс) Ответ отправлен: 11.02.2009, 01:00 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243368 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.153

доброго времени суток, помогите реализовать слудующую задачу: в файле целых чисел хранятся последовательности не нулевых чисел. Ноль- разделитель последовательностей. Преобразовать файл, удалив в каждой последовательности члены между первым и вторым отрицательным числом, если отрицательных чисел меньше двух, последовательность исключить из файла,....,и если можно при выполнении задачи не использовать:goto, break, exit,...,заранее спасибо!

Отправлен: 11.02.2009, 01:47 Вопрос задал: Фирулин Андрей Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Botsman Здравствуйте, Фирулин Андрей Николаевич! Вот, набросал. Программа сначала создает файл input.dat (файл целых чисел), заполняет его случайными числами. Итоги работы сохраняются в файле output.dat. Оба файла выводятся на экран во время работы. Если нужно именно ПРЕОБРАЗОВАТЬ файл, т.е. сохранить результаты в исходном файле, можно удалить исходный файл (процедура ERASE) и переименовать (RENAME) итоговый файл в input.dat Приложение: uses crt; const inpFNm = 'input.dat';{ishodnyi file} outFNm = 'output.dat';{itogovyi file} maxLen = 1000;{maximalnaya dlina odnoj posledovatelnosti} var inpF,outF:file of integer; tmp,i:integer; curData : array[1..maxLen] of integer; curlen:integer; {dlina tekushey posledovatelnosti} curNegQty:integer; {tekushee kol-vo otricatelnyh chisel} procedure createFile(fileName:string); {formiruem ishodniy file i zapoln'aem ego sluchajnymi chislami } var f:file of integer; tmp,i:integer; begin assign(f,fileName); rewrite(f); for i:=1 to 100 do begin tmp:=-3+trunc(random*10); write(f,tmp); end; close(f); end; procedure printFile(file_name:String); {vyvod soderzhimogo fila na ekran} var f:file of integer; tmp:integer; begin assign(f,file_name); reset(f); while not eof(f) do begin read(f,tmp); write(tmp); write(' '); end; close(f); end; BEGIN clrscr; randomize; createFile(inpFNm); writeln('ISHODNYI FILE (',inpFNm,'):'); printFile(inpFNm); assign(inpF,inpFNm); assign(outF,OutFNm); reset(inpF); rewrite(outF); while not eof(inpF) do begin curLen:=0; curNegQty:=0; repeat read(inpF,tmp); if tmp<>0 then begin curLen:=curLen+1; curData[curLen] :=tmp; if tmp<0 then curNegQty:=curNegQty+1; end; until (tmp=0) or eof(inpF); if curNegQty>=2 then begin curNegQty:=0; for i:=1 to curLen do if curData[i]<0 then begin curNegQty:=curNegQty+1; write(outF,curData[i]); end else if curNegQty<>1 then write (outF,curData[i]); tmp:=0; if not eof(inpF) then write(outF,tmp); end; end; close(inpF); close(outF); writeln; writeln; writeln('ITOGOVYI FILE (',outFNm,'):'); printFile(outFNm); readln; END.

Ответ отправил: Botsman (статус: 4-й класс) Ответ отправлен: 11.02.2009, 16:37 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243408 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru