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

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

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

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

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

Botsman Статус: 5-й класс Рейтинг: 45 ∙ повысить рейтинг >>

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

Выпуск № 812
от 18.02.2009, 04:05

Вопрос № 160265: C помощью while,for,until.Даны действительные числа а[1..n],b[1..m].В последовательности а[1..n] и в последовательностиb[1..m] все члены, следующие за членом с наибольшим значением, заменить на 0.5....

Вопрос № 160.265

C помощью while,for,until.Даны действительные числа а[1..n],b[1..m].В последовательности а[1..n] и в последовательностиb[1..m] все члены, следующие за членом с наибольшим значением, заменить на 0.5.

Отправлен: 12.02.2009, 08:28 Вопрос задал: Гришко Максим Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Botsman Здравствуйте, Гришко Максим Сергеевич! Вот решение вашей задачи. Реализовано по принципу 3-в-одном :) Поскольку при помощи разных циклов нужно было ОБРАБАТЫВАТЬ последовательности, процедуры ГЕНЕРАЦИИ последовательности и ПЕЧАТИ едины для всех трех случаев и основаны на цикле FOR. Хотя при необходимости можно поправить и это. Приложение: uses crt; const n = 12; m = 10; var a: array[1..n] of real; b: array[1..m] of real; i,na,nb:integer; procedure fillArrays; var i: integer; begin for i:=1 to n do a[i] := 10*random; for i:=1 to m do b[i] := 10*random; end; procedure printArrays; var i:integer; begin writeln ('posledovatelnost a:'); for i:=1 to n do write (a[i]:6:2); writeln; writeln ('posledovatelnost b:'); for i:=1 to m do write (b[i]:6:2); writeln; end; procedure findMaxFOR; var i:integer; begin na:=1; for i:=2 to n do if a[i]>a[na] then na:=i; nb:=1; for i:=2 to m do if b[i]>b[nb] then nb:=i end; procedure replaceAfterMaxFOR; var i:integer; begin if na<n then for i:=na+1 to n do a[i]:=0.5; if nb<m then for i:=nb+1 to m do b[i]:=0.5; end; procedure findMaxWHILE; var i:integer; begin na:=1; i:=2; while i<=n do begin if a[i]>a[na] then na:=i; i:=i+1; end; nb:=1; i:=2; while i<=m do begin if b[i]>b[nb] then nb:=i; i:=i+1; end; end; procedure replaceAfterMaxWHILE; var i:integer; begin if na<n then begin i:=na+1; while i<= n do begin a[i]:=0.5; i:=i+1; end; end; if nb<m then begin i:= nb+1; while i<=m do begin b[i]:=0.5; i:=i+1; end; end; end; procedure findMaxREPEAT; var i:integer; begin na:=1; i:=2; repeat if a[i]>a[na] then na:=i; i:=i+1; until i>m; nb:=1; i:=2; repeat if b[i]>b[nb] then nb:=i; i:=i+1; until i>m; end; procedure replaceAfterMaxREPEAT; var i:integer; begin if na<n then begin i:=na+1; repeat a[i]:=0.5; i:=i+1; until i>n; end; if nb<m then begin i:= nb+1; repeat b[i]:=0.5; i:=i+1; until i>m; end; end; BEGIN clrscr; randomize; WRITELN('ISPOLZUEN FOR.'); fillArrays; writeln('DO:'); printArrays; findMaxFOR; replaceAfterMaxFOR; writeln('POSLE:'); printArrays; readln; WRITELN('ISPOLZUEN WHILE.'); fillArrays; writeln('DO:'); printArrays; findMaxWHILE; replaceAfterMaxWHILE; writeln('POSLE:'); printArrays; readln; WRITELN('ISPOLZUEN REPEAT'); fillArrays; writeln('DO:'); printArrays; findMaxREPEAT; replaceAfterMaxREPEAT; writeln('POSLE:'); printArrays; readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

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

Вопрос № 160.325

Пацаны, помогите с задачей: Написать программу вычитания целых 16-ричных чисел(через строки). Заранее спасибо.

Отправлен: 12.02.2009, 20:38 Вопрос задал: Челпанников Алексей Алексеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 20)

Отвечает: Boriss Здравствуйте, Челпанников Алексей Алексеевич! Да шутил я, пока писал Вот посмотрите в приложении. Тестировал, вроде работает правильно Если будут вопросы, спрашивайте в минифоруме Приложение: uses CRT; function InputBinary: String; var buf: String; ch: char; x, y: Integer; begin Write('Введите бинарную строку: '); x := WhereX; y:=WhereY; buf := ''; repeat gotoxy(x + length(buf), y); ch := ReadKey; case ch of '0','1': buf := buf + ch; #8: {backspace} if length(buf) >= 1 then delete(buf, length(buf), 1); end; gotoXY(x, y); write(buf,' ') until (ch = #13) or (ch = #27) or (length(buf) >= 16); {ENTER или Esc} WriteLn; if buf = '' then buf := '0'; InputBinary := buf end; function Convert(num: String): Integer; var i, n, dig: Integer; begin n := 0; dig := 1; while length(num) < 16 do num := '0' + num; for i:= length(num) downto 1 do begin n := n + (ord(num[i])-48)*dig; dig := dig * 2; end; Convert := n end; VAR num1, num2: String; k, m: Integer; BEGIN num1 := InputBinary; num2 := InputBinary; {доводим длину до стандартной 16} writeLn(num1,' ',num2); while length(num1) < 16 do num1 := '0' + num1; while length(num2) < 16 do num2 := '0' + num2; WriteLn('десятичная запись: ',Convert(num1),' - ', Convert(num2)); WriteLn(num1,#10#13,'-',#10#13,num2,#10#13,'-------------'); {вычитание. Пишу как можно проще, то-есть, реализую пошагово действия ручные} for k := 16 downto 1 do case num1[k] of '0': if num2[k] = '1' then begin num1[k] := '1'; m := k -1; while (m >= 1) do begin if num1[m] = '1' then begin num1[m] := '0'; break end else num1[m] := '1'; dec(m) end end; '1': if num2[k] = '1' then num1[k] := '0'; end; WriteLn(num1); WriteLn(' Результат в десятичной форме: ', convert(num1)); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 12.02.2009, 23:09 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243516 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Зенченко Константин Николаевич Здравствуйте, Челпанников Алексей Алексеевич! Программа работающая в 16-ой СС(ввод-вывод), в приложении. По функциям: HexToBin рекурсивная функция преобразовывающая число в 16-ой системе в двоичную запись. inputHex подпрограмма вводит число в 16-ой системе и возвращающая число в двоичной, запись двоичного числа производится в обратном порядке, с помощью этого достигается выравнивание чисел, т.е. разряды с одинаковым весом имеют одинаковые позиции в строке. outputHex рекурсивная процедура выводит число в 16-ой системе. При рекурсии каждый раз обрабатывается одна 16-я цифра. doSummaBin процедура суммирования двух двоичных чисел. rangeBin процедура выравнивает введенные числа на размер определенный в разделе констант. convertBin процедура перевода двоичного числа в дополнительный код. Рабочимы числами в программе есть двоичные, а ввод и вывод производится в 16-ой системе, практически как и в самом процессо ре. Удачи! Приложение: uses crt; const n=32; type TMass=string[n]; var a,b,c:TMass; function HexToBin(d,e:integer):string; begin {корректируем под 16-е число} dec(d,7*ord(d>9)); HexToBin:=''; {рекурсивно формируем 16-е число ввиде двоичной строки} if e>0 then HexToBin:=chr(ord('0') + d mod 2) + HexToBin(d div 2,e-1); end; procedure inputHex(var d:TMass;e:char); begin{inputHex} {вводим число в обратном порядке} write('Enter number',e:2,':'); d:=''; repeat e:=ReadKey;{символ без эхо} case e of '0'..'9','A'..'F','a'..'f': begin e:=chr(ord(e) - 32*ord(e>'Z'));{приводим число к единому регистру} write(e);{выводим его} d:=HexToBin(ord(e)-ord('0'),4)+d;{формируем двоичную строку} end; end;{case} until (e=chr(13))or(length(d)=n);{} writeln; end;{inputHex} procedure outputHex(d:TMass); var i:integer; e:string; begin{outputHex} if length(d)>0 then begin{if} e:=copy(d,1,4);{получаем четыре бита} delete(d,1,4);{удаляем их их числа} outputHex(d);{рекурсивно вызываем себя} i:=0; while length(e)>0 do{преобразовываем строку в число} begin{while} i:=i*2 + ord(e[length(e)]) - ord('0'); delete(e,length(e),1); end;{while} inc(i,7*ord(i>9));{корректируем его с учетом 16-ой системы} e:=chr(ord('0')+i);{формируем символ и выводим его} write(e); end;{if} end;{outputHex} 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} {вводим числа} inputHex(a,'A'); inputHex(b,'B'); {выравниваем к одному размеру} rangeBin(a); rangeBin(b); {переводим в дополнительный код} convertBin(b,'1'); {суммируем А + Вд} doSummaBin(a,b); {выводим результат} outputHex(a); ReadKey; end.{main} --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 160.347

Люди, пожалуйста помогите мне со следующей задачей: Перевод вещественных чисел из 8 с.с. в 10с.с. Заранее благодарю.

Отправлен: 12.02.2009, 23:54 Вопрос задал: Шибалов Леонид Витальевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Boriss Здравствуйте, Шибалов Леонид Витальевич! Вот в приложении код программы. По-моему, все просто. Но если что не будет понятно, пишите в минифоруме - поясню НО! в целях простоты не ограничивал длину ввода, а надо-бы (но будет сложнее). Сделать? Приложение: uses CRT; function OctToDEC(src: String): LongInt; var n: LongInt; begin n:= 0; while src <> '' do begin n := n*8 + (ord(src[1]) - 48); delete(src, 1, 1); end; OctToDec := n end; var S: String; ch: Char; BEGIN Write('Введите число в восьмеричной системе счисления: '); S := ''; repeat ch:= ReadKey; case ch of '0'..'7': S := S + ch; {можно ввести обработку клавиш типа bsckspace для редактирования} #13,#27,' ': Break; {Выход из цикла по нажатию ENTER, Esc, пробел} ELSE ch:=#7; {свисток} end; Write(ch); until FALSE; {бесконечный цикл заканчивается с помощью Break} if S = '' then S := '0'; {может оказаться пустой строка} { Тест S := '12324'; должно быть 5332 } WriteLn; WriteLn('Восьмеричное число ',S,' = десятичному ', OctToDec(s)); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 13.02.2009, 10:26 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243534 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Denisss Здравствуйте, Шибалов Леонид Витальевич! Пример решения задачи с комментариями находится в приложении. Перевод вещественного числа 8 с.с. в вещественное число 10 с.с. осуществляется в два этапа: 1. Перевод целой части; 2. Перевод дробной части. В приведенном примере учтены следующие моменты: - число может быть положительным или отрицательным; - если число начинается с "." или "-.", то автоматически считается, что это "0." или "-0."; - если число заканчивается на точку, то дробная часть не вычисляется. Точность вычисления десятеричного числа ограничивается типом Real (в TP 7 длина 6 байт). Для увеличения точности, если потребуется, можно воспользоваться типом Double (8 байт) или Extended (10 байт). Успехов! Приложение: program Q160347; { Функция проверки правильности ввода } function CheckOctR(const oct: String): Boolean; var i: Byte; p, res: Boolean; begin { Результат } res:= True; { Флаг точки } p:= False; { Если число отрицательное } if (oct[1] = '-') then i:= 2 else i:= 1; { Перебор всех символов } while ((i <= Length(oct)) and res) do begin { Встретилась точка } if (oct[i] = '.') then begin { Если уже была точка } if (p) then { то результат "ЛОЖЬ" } res:= False; { Запоминаем точку } p:= True; end else { В восьмеричной с.с. цифры от 0 до 7 } res:= oct[i] in ['0'..'7']; Inc(i); end; CheckOctR:= res; end; { Функция перевода вещественного числа } { из 8 в 10 с.с. } function OctToReal(const oct: String): Real; var res, tmp: Real; i, zero, lng: Byte; begin { Результат } res:= 0.0; { Код нуля } zero:= Ord('0'); { Длина введенной строки } lng:= Length(oct); { Если число отрицательное } if (oct[1] = '-') then { то начинаем со второго символа } i:= 2 else { иначе - с первого } i:= 1; { 1. Перевод целой части числа в 10 с.с. } { Перебираем символы до конца строки } { или до точки } while ((i <= lng) and (oct[i] <> '.')) do begin res:= res*8.0; res:= res + (Ord(oct[i]) - zero); Inc(i); end; { 2. Перевод дробной части числа в 8 с.с. } { Временная переменная, хранит 8^(-i) } tmp:= 1.0/8.0; { Если еще не все число перебрали } if (i <= Length(oct)) then { Переходим к следующему символу } Inc(i); { Теперь перебираем до конца строки } while (i <= Length(oct)) do begin res:= res + tmp*(Ord(oct[i]) - zero); { При делении 8^(-(i - 1)) на 8 получаем 8^(-i) } tmp:= tmp/8.0; Inc(i); end; { Если было введено отрицательное число } if (oct[1] = '-') then { то меняем знак результата } res:= -res; OctToReal:= res; end; var anOct: String; aReal: Real; begin { Вводим вещественное число 8 с.с. } Write('oct = '); ReadLn(anOct); { Проверяем правильность ввода } if CheckOctR(anOct) then { преобразуем } WriteLn('real = ', OctToReal(anOct)) else { иначе сообщаем об ошибке } WriteLn('ERROR'); { Ждем, когда пользователь нажмет [Enter] } ReadLn; end. --------- Все должно быть сделано настолько просто, насколько это возможно. Но не проще. (с) А.Эйнштейн

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 2412904 ---- Ответ отправлен: 14.02.2009, 10:42 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243616 на номер 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