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

Выпуск № 652
от 10.07.2008, 07:05

Вопрос № 139.009

ЗдраствуйТе!...Помогите пожалуста до делать программу....вот само задание.Число m, составлено из цифр числа n так, что сначало идут четные цыфры чила n , а затем нечетные (в том же порядке что и n). Приложение: program lab5; uses crt; label 1; var i,j,q,f,w,k:integer; n: array[1..100] of integer; a: array[1..100] of integer; m: array[1..100] of integer; begin clrscr; 1:write ('Ââåäèòå ÷èñëî - '); read(k); if (k<=8) then begin write('!vvedite chislo ot 9 do 100!');goto 1;end; clrscr; for i:=1 to k do begin write('n[',i,']='); readln(n[i]); if (n[i] mod 2 = 0) then begin m[j]:=n[i]; inc(j);end else begin a[q]:=n[i];inc(q);end; end; f:=j+q; for i:=j to f do begin m[j]:=a[w];inc(w);end; for i:=1 to k do write (m[i],' '); readln;readln; end.

Отправлен: 04.06.2008, 14:53 Вопрос задал: Китаев Кирилл Артурович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: SHERRY Здравствуйте, Китаев Кирилл Артурович! Не знаю зачем Вы брали массивы - тут и без них всё прекрасно решается. Берём число, делим его дробно на 10. Смотрим: если частное есть числом нечётным, то дописываем его в результат, умножая на 10 в степени, которая является номером цифры в новом (формируемом числе). И так до тех пор, пока исходное число не станет равно нулю. Потом то же самое, но частное проверяем на нечётность. Следует заметить, что результирующее число при этом формируется задом-наперёд. Смотрите код задачи в приложении. Если что-то будет непонятно - пишите в мини-форум или ЛС. Приложение: var a,b,i: integer; rez: real; begin readln(a); b:= a; i:=0; a:= b; rez:= 0; while a<>0 do begin if Odd(a mod 10) then begin inc(i); rez:= rez + (a mod 10)*exp(i*ln(10)); end; a:= a div 10; end; a:= b; while a<>0 do begin if not Odd(a mod 10) then begin inc(i); rez:= rez + (a mod 10)*exp(i*ln(10)); end; a:= a div 10; end; writeln((rez/10):1:0); {в конце числа добавляет лишний нуль. поэтому я его убираю, разделив результат на 10} readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 04.06.2008, 16:40

Вопрос № 139.110

Здраствуйте,у меня просьба написать программу: Дана патрица A(m,n) вычислить координаты найменшего элемента матрицы.

Отправлен: 05.06.2008, 09:48 Вопрос задал: Щербаков Евгений Николаевич Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Павел Шведенко Здравствуйте, Щербаков Евгений Николаевич! Вот такой код: Приложение: var i,j, im, jm, m, n: integer; a : array[1..20,1..20] of Integer; el : integer; BEGIN // Заполнение массива А el = a[1,1]; im:=1; jm:=1; for i:=1 to m do begin for j:=1 to n do begin if a[i,j]< el then begin el := a[i,j]; im:=i; jm:=j; end; end; end; Writeln("Мин элемент ",el," с координатами (x,y):",im,",",jm,")" ); END. --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 05.06.2008, 10:42

Отвечает: Костя Симанович Здравствуйте, Щербаков Евгений Николаевич! Ответ в приложении с коментариями. Если требуется матрицу ввести в ручную, то надо раскоментировать строку readln(a[i, j]) строку a[i, j] := random(100) закоментировать. Надеюсь помог. Удачи. Приложение: program min_max; const m = 5; {можно менять размерность матрицы} n = 5; var i , j : integer; a : array [1..m, 1..n] of integer; min, im, jm : integer; begin {массив заполняем случайными числами} randomize; {готовимся к случ. заполнению} for i := 1 to m do {заполняем} for j := 1 to n do begin a[i, j] := random(100); {заполняем случайно} {readln(a[i, j]);} {заполняем в ручную} end; {выводим что получилось} writeln; for i := 1 to m do begin for j := 1 to n do write(a[i, j], ' '); writeln; end; writeln; min := a[1, 1]; im := 1; jm := 1; {считаем, что первый эл-т минимальный} {ищем мин. эл-т} for i := 1 to m do for j := 1 to n do begin if min > a[i, j] then begin min := a[i, j]; im := i; jm := j; end; end; {выводим результат} writeln('минимальный эл-т матрици = ', min); writeln('координаты i = ', im,'; j = ', jm); readln; {ждем нажатия enter} end.

Ответ отправил: Костя Симанович (статус: 4-ый класс) Ответ отправлен: 08.06.2008, 11:36

Вопрос № 139.111

Здраствуйте! Помогите решить проблему, а именно: как установить видимый и невидимый курсор во время выполнения программы?

Отправлен: 05.06.2008, 09:53 Вопрос задал: Щербаков Евгений Николаевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Можно изменить размер курсора до нуля с помощью следующих операторов: В разделе описания программы: Uses DOS; Var r: registers; B разделе выполнения программы: r.ah:=1; r.ch:=$20; intr(16,r); Как обратно, не знаю, надо смотреть DOS.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 09:18

Вопрос № 139.116

Помогите написать программу для расчёта функции y=a+bthx, где th - тангенс гиперболический.

Отправлен: 05.06.2008, 10:11 Вопрос задал: Щербаков Евгений Николаевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Щербаков Евгений Николаевич! Гиперболический тангенс - это частное гиперболических синуса и косинуса. sh x = (ex-e-x)/2 ch x = (ex+e-x)/2 th x = sh x/ch x = (ex-e-x)/(ex+e-x) Для нахождения экспоненты аргумента в Паскале есть функция exp (x: real), с её помощью можно написать простую функцию нахождения th x. Остальное делается совсем уж просто. Программа в приложении. Удачи! Приложение: Var y, a, b, x: real; function th (x: real): real; {Функция нахождения гиперболического тангенса от х} begin th:= (exp (x)-exp(-x))/(exp (x)+exp(-x)); {Находим значение по формуле} end; begin readln (a, b, x); {Входные данные} y:= a+b*th(x); {Заданная функция} writeln (y:5:5); {Форматированный вывод} readln; {Ждём нажатия клавиши} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 05.06.2008, 14:08

Вопрос № 139.137

дана строка символов. Удалить из строки буквы "а"( оформить в виде процедуры)

Отправлен: 05.06.2008, 12:01 Вопрос задал: Solnischko Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Solnischko! Программа использует строковые процедуры и функции. Удаления символа происходит с помощью рекурсивной процедуры CHANGE, которая вызывает сама себя, каждый раз с новыми значениями. Удачи! Приложение: var a:string; b:char; procedure change(var c:string;d:char); begin delete(c,pos(d,c),1);{удаляем символ} if pos(d,c)>0 then change(c,d);{снова вызываем саму себя, пока ещё есть символ в строке} end; begin write('Enter string:');readln(a); write('Enter simbol:');readln(b); change(a,b);{вызываем процедуру} writeln('Result:',a); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 05.06.2008, 13:49

Отвечает: Абельхарисов Руслан / Marked O Здравствуйте, Solnischko! Задача в приложении. Удаляет маленькие русские буквы а. Удачи!!! Приложение: {Удаляет а, параметр - строка из которой будут удалены буквы, результат созранится в этой же переменной} procedure KillA(var s: string); var {Для For} I: integer; {Временная переменная} NewS: string; begin {Очищаем временную строку} NewS:=''; {В цикле перебираем её} for i:=1 to Length(s) do {если тек. символ - не русская маленькая а, то добавляем его в новую строку} if (s[i]<>'а') then NewS:=NewS+s[i]; {Сохраняем результат} s:=NewS; end; var {сторка} MyStr: string; begin {Получаем строку} Write('Введите строку: '); ReadLn(MyStr); {Удаляем а} KillA(MyStr); {Выводи рез-тат} Write('Результат: ', MyStr); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked O (статус: Студент) Ответ отправлен: 05.06.2008, 14:00

Вопрос № 139.153

Уважаемые эксперты помогите сделать задачу : Напишите программу, которая осуществляет поиск заданного слова в текстовом файле.

Отправлен: 05.06.2008, 13:10 Вопрос задал: Xbondx Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Xbondx! Решение задачи с небольшими пояснениями в приложении. Приложение: uses crt; var f:text; s,str:string; k:integer; begin clrscr; assign(f,'slovo.txt'); {наш файл} reset(f); write('slovo:');readln(s);{заданное слово} k:=0; while not eof(f) do begin readln(f,str); {читаем очередную строку} if pos(s,str)>0 then {если есть это слово} begin k:=k+1; {считаем} end; end; if k>0 then writeln('Takoe slovo est!') {если есть, сообщаем} else if k= 0 then writeln('Takogo slova net!');{если ноль- нет, сообщаем} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 09:42

Вопрос № 139.154

Уважаемые эксперты помогите сделать задачу : Написать программу получения результата умножение двух целых чисел, первое из которых имеет N десятичных разрядов, второе – M разрядов(N,M <=30). Числа вводятся из клавиатуры

Отправлен: 05.06.2008, 13:11 Вопрос задал: Xbondx Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Xbondx! Программа в приложении. Ввод чисела происходит до нажатия клавишы "Enter" или пока не будет введено 30-ть цифр. Удачи! Приложение: uses crt; const z=30; type TMas=array[1..z]of integer; var a,b:TMas; c:array[1..2*z]of integer; i,j,x,y:integer; {функция ввода числа} function EnterMas(var d:TMas):integer; var i:integer; c:char; begin i:=0; write('Enter Number:'); repeat {ожидаем нажатия только цифровой клавиши} c:=ReadKey; if (c>='0')and(c<='9')then begin {увеличиваем счетчик и запоминаем цифру} inc(i); d[i]:=ord(c)-48; write(c); end; until (ord(c)=13)or(i=z); {возвращаем количество цифр в числе} EnterMas:=i; writeln; end; begin {вводим числа} x:=EnterMas(a); y:=EnterMas(b); {обнуляем массив результата} for i:=1 to 2*z do c[i]:=0; {само умножение} for i:=x downto 1 do for j:=y downto 1 do begin {перенос в старший разряд} inc(c[x-i+2+y-j],(c[x-i+1+y-j]+a[i]*b[j])div 10); {умножение текущго разряда} c[x-i+1+y-j]:=(c[x-i+1+y-j]+a[i]*b[j])mod 10; end; write('Resultat:'); {пропускаем начальные нули} i:=2*z; while (c[i]=0)and(i>1)do dec(i); {выводим результат} for j:=i downto 1 do write(c[j]); writeln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 06.06.2008, 15:50

Вопрос № 139.157

расписание электричек хранится в текстовом файле. Каждая запись хранит номер электрички, время ее отправления и конечный пункт назначения. Написать программу выполняющую: вывод на экран данных р номере электрички с клавиатуры; Вывод на экран сведений об электричках приходящих в Псков.

Отправлен: 05.06.2008, 13:40 Вопрос задал: Solnischko Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Solnischko! Создаем текстовый файл, в котором в каждой строчке через один пробел записываем данные по условию, ничего не путая. Текст латиницей, иначе программа ничего не прочитает кроме цифр. Сохраните файл с именем латиницей не более 8 символов, лучше в той же директории, что и программа. Образец файла прилагаю. Код программы с подробными объяснениями в приложении. Приложение: ses crt; type Trasp=record {тип запись с полями по условию} nom:word; {номер} otpr:string[5]; {время отправления} punkt:string[20];{пункт назначения} end; var sp:array[1..50] of Trasp;{массив записей-расписание} i,n,k:byte; f:text; {переменная текстового файла} s:string; {переменная для хранения строковых данных} t:word; {переменная для хранения номера} c:integer; {переменная при переводе строки в число} begin clrscr; assign(f,'raspis.txt');{связываем наш файл с переменной} reset(f); {открываем его для чтения} n:=0; while not eof(f)do begin n:=n+1; readln(f,s); {считываем очередную строку} val(copy(s,1,pos(' ',s)-1),t,c);{первое слово преобразуем в число} sp[n].nom:=t; {присваиваем его полю номер} delete(s,1,pos(' ',s)); {удаляем начало строки с пробелом} sp[n].otpr:=copy(s,1,pos(' ',s)-1);{второе слово-время отпр.} delete(s,1,pos(' ',s)); {удаляем} sp[n].punkt:=s; {остаток строки-пункт назначения} end; write('Nomer elektrichki: '); readln(t); writeln; k:=0; for i:=1 to n do if sp[i].nom=t then {если есть такой номер,выводим о нем сведения} begin writeln('Otpravljaetsa ',sp[i].otpr,' v ',sp[i].punkt); k:=k+1; {считаем} end; if k=0 then writeln('Takoj elektrichki net!');{если ноль, сообщаем} writeln; writeln('Elektrichki na Pskov:'); writeln; for i:=1 to n do if sp[i].punkt='Pskov' then {если есть такой пункт, выводим сведения из расписания} begin writeln('Nomer ',sp[i].nom,' Otpravljaetsa ',sp[i].otpr); k:=k+1; {считаем} end; if k=0 then writeln('Elektrichek na Pskov net!'); {если 0, сообщаем} readln; close(f); {закрываем файл} end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 11:07

Вопрос № 139.164

Дана целочисленная прямоугольная матрица. Определить сумму элементов в тех столбцах которые не содержат отрицательных элементов (оформить в виде функции).

Отправлен: 05.06.2008, 14:28 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Пухов Никита Евгеньевич! Ваша функция в приложении. Использование: const n = 4; mm = 5; type zzz = array [1..n, 1..mm] of integer; var ms: zzz; i,j,sum: integer; begin {массив должен быть заполнен} sum:= ok(ms); readln; end. Приложение: function ok(var m: zzz): integer; {задаём функцию - входящий параметр - двумерный массив целых чисел; возвращемое значение целочисленного типа} var p,q,t, rez: integer; {вспомогательные переменные} CanSum: boolean; {признак того, что все элементы столбца положительные} begin rez:= 0; {инициализация} CanSum:= true; for q:=1 to mm do begin CanSum:= true; t:= 0; for p:=1 to n do begin t:= t + m[p,q]; CanSum:= CanSum and (m[p,q]>0); end; if CanSum then rez:= rez + t; end; ok:= rez; end; --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 05.06.2008, 16:50

Вопрос № 139.166

Составить программу для нахождения их двух целых чисел наибольшего числа (оформить в виде процедуры).

Отправлен: 05.06.2008, 14:29 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: SHERRY Здравствуйте, Пухов Никита Евгеньевич! В идеаль было бы оформить эту задачу через функцию. В приложении решение в виде процедуры и функции. При использовании процедуры значение максимального элемента присваивается первой переменной, введённой в качестве входящего параметра. Например: ok(a, b) -> максимум будет хранится в переменной a. С функцией всё проще. Её значение можно присвоить любой переменной. Приложение: procedure ok(var a,b: integer); begin if a<b then a:= b; end; function ok_2(var a,b: integer): integer; begin ok_2:= a; if a<b then ok_2:= b; end; --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 05.06.2008, 16:30

Вопрос № 139.168

Описать запись с именем Zodiak, содержащую следующие поля: *Фамилия, имя *Знак зодиака *День рождения (массив из 3 чисел). Написать программу выполняющую следующие действия: *ввод данных с клавиатуры в массиа, состоящий из восьми элементов типа Zodiac по знаку зодиака, введенному с клавиатуры. *Вывод данных о людях с фамилией выведенно с клавиатуры.

Отправлен: 05.06.2008, 14:30 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Пухов Никита Евгеньевич! Вот решение Вашей задачи. Описываем свой тип Zodiak, в нём нужные Вам "поля". Потом объявляем переменную people как массив массив нашего типа Zodiak и работаем с нашим массивом. Количество людей хранится в переменной n. Код задачи и описание действий в приложении. Приложение: const n = 4; {количество людей} Type Zodiak = record {наш тип Zodiak содержит} FIO: string[50]; {фио человека} znak: string[15]; {знако зодиака} birth: array [1..3] of integer; {дата рождения разложе, как Вы и хотели, в массиве. Элемент №1 - день, №2 - месяц, №3 - год} end; var people: array [1..n] of Zodiak; {храним данные в масиве нашего типа Zodiak} i: integer; {вспомогательная переменная-счётчик} s: string; {строка для поиска по фио} NotExists: boolean; {признак существования результата поиска} begin NotExists:= true; {предполагаем, что наш поиск не даст результатов} for i:=1 to n do {заполняем данные массива} begin write('Input FIO '); readln(people[i].fio); {фио} write('Input zodiak '); readln(people[i].znak); {знак зодиака} write('Input day of birth '); {дата рождения: } readln(people[i].birth[1]); {день} write('Input mounth '); readln(people[i].birth[2]); {месяц} write('Input year '); readln(people[i].birth[3]); {год} writeln; end; writeln; write('Search by FIO. Please, type your FIO '); readln(s); {считываем строку для поиска} for i:=1 to n do if s = people[i].FIO then {если найдено совпадение по фио} begin writeln(people[i].fio, ' ', people[i].birth[1], '.', people[i].birth[2], '.', people[i].birth[3], ' ', people[i].znak); {то выведем данные о найденном человеке на экран} NotExists:= false; {результат найден} end; if NotExists then writeln('Sorry, nothing found..'); {если поиск не дал результатов, то выведем соответствующее сообщение на экран} readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 05.06.2008, 16:19

Вопрос № 139.204

Есть программа создающая отсортированное бинарное дерево Необходимо дописать рекурсивную процедуру вычисления средних арифметических элементов узлов правого и левого поддерева соответствеено и вставить это значение в дерево. Помогите пожалуйста. Приложение: Program lab3; Uses CRT,Graph; Const n=15; r=12; Type u=^usl; usl=Record i :Integer; L,R :u; End; Var h :u; {$I GrInit} Procedure Obhod (h:u); Begin If h<>nil Then Begin {1} Obhod (h^. L); {2} Write (h^. i); {3} Obhod (h^. R); End; End; Procedure ShowTree ( h :u; x, y, w, f :Integer ); Var s :String; Begin If h <> Nil Then Begin ShowTree (h ^.L, x-w div 4, y+4*r, w div 2, 1); If f <> 0 Then Line( x, y, x + f*(w div 2), y-4*r ); Circle(x,y,r); Str(h^.i, s); OutTextXY(x,y,s); ShowTree (h^.R, x+w div 4, y+4*r, w div 2,-1); End; End; Procedure InsUsl ( h: u; a: Integer); Var t, p: u; Begin t:= h; While t<> Nil Do Begin p:= t; If a < t^. i Then t := t^. L Else t := t^. R; End; New (t); t^. i := a; t^. L := Nil; t^. R := Nil; If a < p^. i Then p^. L := t Else p^. R := t; End; Var j :Integer; Begin GrInit; Randomize; SetTextJustify ( CenterText, CenterText ); New(h); With h^ Do Begin i:=Random(100); L:=Nil; R:=Nil; End; For j:=1 To n-1 Do InsUsl ( h, Random(100) ); ShowTree(h,320,50,640,0); { Obhod (h);} ReadKey; End.

Отправлен: 05.06.2008, 19:01 Вопрос задал: Ильина Анна Анатольевна Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Ильина Анна Анатольевна! Можно сделать так. Пишем обычную нерекурсивную функцию, а внутри неё рекурсивный обход, в котором сможем обращаться к переменным, объявленным в функции, как к глобальной. Выглядеть это будет так: function SrAlph (h:u): real;{Функция, которую вызовем из главной программы} Var s, k: integer;{Переменные для суммы и количества элементов} Procedure ObhodS (h:u); {Рекурсивная процедура обхода} Begin  If h<>nil Then Begin   ObhodS (h^. L);   s:= s+h^. i; {Наращиваем сумму и количество}   inc (k);   ObhodS (h^. R);  End; End; begin  s:=0; k:=0;{Обнуляем переменные}  ObhodS (h);{Вызываем функцию}  if k<>0 then SrAlph:= s/k else SrAlph:= s;{Считаем среднее арифметическое} end; В основной программе эту функцию надо вызвать два раза, передав правое и левое поддерево соотвественно, т.е. наприм ер writeln (SrAlph (h^.L)); writeln (SrAlph (h^.R)); Ну, а вставить понятно как - для полученных значений вызвать Вашу функцию вставки. Удачи! --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 06.06.2008, 23:25

Вопрос № 139.209

Уважаемые эксперты СПАСИТЕ пожалуйста ЗАВТРА ЗАЧЕТ по програмированию ответьте ПОЖАЛУЙСТА на вопрос как найти (2n+1)*! Заранее благодарю. Приложение: !-вактариал

Отправлен: 05.06.2008, 19:50 Вопрос задал: Кузнецов Алексей Владимирович Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Кузнецов Алексей Владимирович! Программа в приложении. Факториал вычисляется с помощью рекурсивной функции, которая вызывает сама себя каждый раз с другими значениями. Удачи! Приложение: var n:integer; {рекурсивная функция} function Factr(x:integer):longint; begin {пока больше единицы выполняем последовательно умножение} if x>1 then Factr:=x*Factr(x-1) else Factr:=1; end; begin {вводим число} write('Enter N:');readln(n); {выводим результат} writeln('Factorial (2*',n,'+1):=',Factr(2*n+1)); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 05.06.2008, 20:11

Отвечает: Абельхарисов Руслан / Marked O Здравствуйте, Кузнецов Алексей Владимирович! Во-первых, не вакториал, а факториал. Материал из Википедии: Факториа́л числа n (обозначается n!, произносится эн факториа́л) — произведение всех натуральных чисел до n включительно. Есть два способа получения факториала: С помощью рекурсии: function fact(n:word):longint;  begin   if n<=1 then    begin     fact:=1;     exit;    end;    fact:=fact(n-1)*n;  end; И без неё, с помощью цикла For: function factorial(n:word):longint; var   i:word;   f:longint;  begin   if n<=1 then    begin      factorial:=1;     exit;    end;    f:=1;    for i:=1 to n do     f:=f*i;    factorial:=f;  end; В приложении пример без рекурсии. Удачи на зачете!!! P.S. Примеры реализации функции факториал Убрано выделение красным цветом. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 05.06.2008, 20:37 (MCK) Приложение: function factorial(n: integer): longint; var i: integer; f: longint; begin if n<=1 then factorial:=1 else begin f:=1; for i:=1 to n do f:=f*i; factorial:=f; end; end; var n: integer; begin Write('Введите n: '); ReadLn(n); Write('(2n+1)*n! = ', (2*n+1)*factorial(n)); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked O (статус: Студент) Ответ отправлен: 05.06.2008, 20:26

Вопрос № 139.216

Уважаемые эксперты помогите пожалуйста решить задачку на тему модули! Приложение: Поместить все подпрограммы (см.ниже 1,2,3) в отдельный модуль и подключить этот модуль в тех программах, где ранее вызывались соответствующие подпрограммы. Удалить подпрогаммы из этих файлов. 1. const z=10; var a:array[1..z,1..2]of integer; i,j,k,l,m,n:integer; function R(x,y:integer):real; begin R:=sqrt((a[x,1]-a[y,1])*(a[x,1]-a[y,1])+(a[x,2]-a[y,2])*(a[x,2]-a[y,2])); end; begin readln; writeln('task B:'); for i:=1 to z do for j:=1 to 2 do begin write('Enter ',chr(ord('W')+j),i,':'); readln(a[i,j]); end; k:=1; l:=2; for i:=1 to z-1 do for j:=i+1 to z do if R(i,j)>R(k,l)then begin k:=i; l:=j; end; writeln(a[k,1],':',a[k,2],' ',a[l,1],':',a[l,2]); readln; end. 2. function prost(var ch:integer):boolean; var rez:boolean; z,r:integer; begin rez:=true; z:=ch; for r:=2 to (z div 2) do begin if (z mod r) = 0 then begin rez:=false; break; end; end; prost:=rez; end; var i, n, x:integer; begin Write('Введите N: '); ReadLn(n); for i:=n to 2*n do begin x:=i+2; if prost(i) and prost(x) and (x<=2*n) then Writeln(i, ' и ', i+2); end; ReadLn; end. 3. uses crt; var a,b:longint; function NOD(x,y:longint):longint; begin if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y; end; begin clrscr; readln(a,b); writeln( 'ЌЋ„ нвЁе зЁбҐ« = ', NOD(a,b) ); readln end.

Отправлен: 05.06.2008, 21:06 Вопрос задал: Денисов Игорь Александрович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Денисов Игорь Александрович! Создание модуля в двух словах. Открываете новое окно, пишите Unit (имя модуля, оно же имя файла *pas) Interface Здесь описываете константы, типы, и пошите заголовки функций и процедур. Implemetation Здесь подробно описываете функции и процедуры. End. С модулеи все. Сейчас этот файл нужно обычным способом сохранить под тем же именем, что и имя Юнита. Затем нажать Ctrl+F9, выйдет окно с предложением. Выбрать OK. Ваш файл сохранится еще раз, но уже с расширением *tpu. Это и будет модуль. Сейчас поместив его в одну папку с программами, которые его будут использовать, можете с ним работать, для чего в начале каждой программы в разделе Uses нужно указать его имя, как CRT,GRAPH и др. В первой задаче при некоторых введенныъх значениях получается под корнем отрицательное число. Поскольку в смысл программы Вы не соизволили нас посвятить, я понятия не имею, что нужно вводить и что должно получиться. Чтобы программа работала хотябы при тестировании я взял выражение под корнем по модулю. Исправите как Вам надо. Во второй задаче предусмотрел вывод сообщения, если таких пар нет, иначе незнающий пользователь вводит, например 6, и смотрит на пустой экран, думая, что программа не работает (это я такой). На всякий случай приложу файл модуля, сам модуль и подремонтированные программы Код в приложении. Комментарии не пишу, программы Ваши. Приложение: Модуль. unit modul1; interface const z=10; type Tmatr=array[1..z,1..2]of integer; function R(x,y:integer):real; function prost(var ch:integer):boolean; implementation function R(x,y:integer):real; var a:Tmatr; begin R:=sqrt((a[x,1]-a[y,1])*(a[x,1]-a[y,1])+(a[x,2]-a[y,2])*(a[x,2]-a[y,2])); end; function prost(var ch:integer):boolean; var rez:boolean; z,r:integer; begin rez:=true; z:=ch; for r:=2 to (z div 2) do begin if (z mod r) = 0 then begin rez:=false; break; end; end; prost:=rez; end; end. Задача 1. uses crt,modul1; var ms:Tmatr; i,j,k,l:integer; begin clrscr; writeln('task B:'); for i:=1 to z do for j:=1 to 2 do begin write('Enter ',chr(ord('W')+j),i,':'); readln(ms[i,j]); end; k:=1; l:=2; for i:=1 to z-1 do for j:=i+1 to z do if R(i,j)>R(k,l)then begin k:=i; l:=j; end; writeln(ms[k,1],':',ms[k,2],' ',ms[l,1],':',ms[l,2]); readln; end. Задача 2. uses crt,modul1; var i,n,x,k:integer; begin clrscr; Write('Vvedite N= '); ReadLn(n); k:=0; for i:=n to 2*n do begin x:=i+2; if prost(i) and prost(x) and (x<=2*n) then begin Writeln(i, ' & ', i+2); k:=k+1; end; end; if k=0 then writeln('Takih par net!'); ReadLn; end. Задача 3. uses crt,modul1; var a,b:longint; begin clrscr; write('Vvedite 2 celyh chisla:'); readln(a,b); writeln( 'ЌЋ„ нвЁе зЁбҐ« = ', NOD(a,b) ); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 13:02

Вопрос № 139.219

Уважаемые эксперты! Помогите, пожалуйста, решить задачи: 1. Реализовать бинарный поиск в одномерном массиве: а) рекурсивным методом; б) нерекурсивным методом. 2. Сформировать массив слов из строки, состоящей из слов (слово – последовательность символов, не содержащая пробелов). 3. Составить алгоритмы нахождения наибольшего общего делителя а) с помощью рекурсии; б) без её использования. 4. Составить алгоритмы проверки, является ли заданное число простым: а) с использованием “mod”; б) без использования операции “mod” и операций по смыслу схожих с ней. 5. Составить программу перевода целого числа из 10-тичной системы счисления в q-ичную и обратно(с использованием строк, так чтобы результат представлял собой не набор цифр(остатков от деления), а число, которое можно было бы использовать для произведения над ним арифметических действий). Заранее огромное спасибо! Swallow.

Отправлен: 05.06.2008, 21:26 Вопрос задал: Ласточка Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ласточка! Сподобился только на задачу №2. Код с комментариями в приложении. Приложение: Задача 2. uses crt; var s:string; {строка} s1:array[1..100]of string; {массив} i,j:integer; begin clrscr; writeln('s:'); readln(s); i:=1;j:=1; while i<=length(s) do begin if s[i]=' ' then j:=j+1 {если пробел, начинаем новое слово} else s1[j]:=s1[j]+s[i]; {если нет, добавляем символы в слово} i:=i+1; end; for i:=1 to j do writeln(s1[i]); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 13:22

Вопрос № 139.232

HELP HELP HELP ******* УТРОМ ЗАЧЕТ plzzz Нужно дописать программу. Условие:Дано действительное число x вычислить -x^1/1!+x^3/3!-x^5/5!+...-x^(1+2n)/(1+2n)! Приложение: Программа: program sssss; var x,d:real;n,i,c:integer; function factor(i:integer):integer; begin if i=o then factor:=1 else factor:=factor(i-1)*; help--->{ НАПИСАТЬ (2n+1)*! } end; function y(x:real):real; begin if x=0 then y:=0 else if x>0 then y=:c*exp(ln(x)*(2*i+1))/ddd else y:=(-1)*c*exp(ln(-x)*(2*i+1))/ddd; end; begin write (' Значение n= ' ); readln(n); write (' Введите x= ' ); readln(x); d:=0; for i:=0 to n do begin if odd(i) then c:=1 else c:=-1; d:=y(x)+d; end; writeln(' sin(x)=',d:2:4); readln; end.

Отправлен: 05.06.2008, 22:04 Вопрос задал: Кузнецов Алексей Владимирович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Кузнецов Алексей Владимирович! Переделанная программа в приложении. Когда Вы вводите число N, это порядковый номер нечетного числа и при n=10 получается число 5,1090 Е+19, т.е. 21! Удачи! Приложение: program sssss; var x,d:real; n,i,c:integer; {рекурсивная функция факториала} function factor(i:integer):real; begin if i>1 then factor:=factor(i-1)*i else factor:=1; end; begin write (' Значение n= ' ); readln(n); write (' Введите x= ' ); readln(x); d:=0; {все делаем в цикле} for i:=0 to n do d:=d+(1-2*ord(odd(i))){логический тип есть перечисляемым true=1, false=0} *exp(ln(x)*(2*i+1)){степень числа Х} /factor(2*i+1);{факториал нечетного числа} {выводим результат} writeln(' sin(x)=',d:10:6,'Check:=':10,sin(x):10:6); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 05.06.2008, 23:35

Вопрос № 139.245

Уважаемые эксперты! Требуется ваша помощь ибо горю. Есть процедура в библиотеке которая должна находить координаты минимального эл. масива, вот только она не работает - немогу состыковать с выполняющей программой. Текст программы и процедуры в приложении. Приложение: программа program vf; uses mylib; var i,j, im, jm, m, n: integer; a :Tmass; writeln('program N3'); writeln('enter n,m'); readln(n,m); Writeln('enter arrey'); for i:=1 to n do for j:=1 to m do begin read(a[i,j]); end; im:=1; jm:=1; max(n,m,im,jm,a); Writeln('First min element of arrey hawe cordinats (i,j):',im,',',jm,')' ); readkey; writeln; код библиотеки unit mylib19; interface type Tmass=array[1..100,1..100] of integer; Tmas=array[1..100] of integer; procedure max(n,m,im,jm:integer;var a:Tmass); implementation procedure max(n,m,im,jm:integer;var a:Tmass); var i,j,el: integer; begin im:=1; jm:=1; el:=a[1,1]; for i:=1 to m do for j:=1 to n do begin if a[i,j]< el then el := a[i,j]; im:=i; jm:=j; end; end; end.

Отправлен: 05.06.2008, 23:48 Вопрос задал: Щербаков Евгений Николаевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Щербаков Евгений Николаевич! Код программы и модуля в приложении. Модуль сохраняйте под именем mylib19.pas. Удачи! Приложение: {программа} program vf; uses mylib19,crt; var i,j,im,jm,m,n:integer; a:Tmass; begin writeln('program N3'); writeln('enter n,m '); readln(n,m); Writeln('enter arrey'); for i:=1 to n do for j:=1 to m do readln(a[i,j]); im:=1; jm:=1; min(n,m,im,jm,a); Writeln('First min element of arrey hawe cordinats (i,j):',im,',',jm,')' ); readkey; writeln; end. {модуль} unit mylib19; interface type Tmass=array[1..100,1..100] of integer; Tmas=array[1..100] of integer; procedure min(n,m:integer;var im,jm:integer;var aa:Tmass); implementation procedure min; var i,j: integer; begin for i:=1 to n do for j:=1 to m do if aa[i,j] < aa[im,jm] then begin im:=i; jm:=j; end; end; begin {init} end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 06.06.2008, 12:45

Вопрос № 139.246

Здравствуйте! ОЧЕНЬ нужно решить задачу! Используя процедуры, написать программу вычисления значений массива, элемен-тами которого будут значения суммы полученных 4-мя цехами материалов с 3-х складов Огромное спасибо за внимание!! Жду) и надеюсь)

Отправлен: 05.06.2008, 23:50 Вопрос задал: Лиза Аринина Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиза Аринина! Поскольку у Вас всего одно предприятие с установленныим количеством цехов и складов, то Ваши процедуры будут чисто формальными и без параметров, т.к. все переменные глобальные и в процедуры ничего передавать не надо и из них никакие параметры передавать не надо, т.е. по сути в этой программе процедуры и не нужны. Но раз надо, значит надо. Код в приложении. Приложение: uses crt; const n=4; m=3; var a:array[1..n,1..m] of integer; b:array[1..n] of integer; i,j,sum:integer; procedure Vvod; {ввод данных} begin clrscr; for i:=1 to n do for j:=1 to m do begin write('ceh ',i,' skl ',j,' ='); readln(a[i,j]); end; end; procedure Summa; {подсчет сумм по цехам(строкам матрицы)} begin for i:=1 to n do begin sum:=0; for j:=1 to m do sum:=sum+a[i,j]; b[i]:=sum; {записываем суммы в массив} end; end; procedure Vyvod; {вывод массива на экран} begin writeln('Massiv summ:'); for i:=1 to n do write(b[i],' '); end; begin {начало программы} clrscr; Vvod; {ввод} writeln; Summa; {создание массива} Vyvod; {вывод на экран} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 14:08

Вопрос № 139.247

Господа эксперты! Помогите пожалуйста с решением следущей задачи: Составить программу, обеспечивающую создание файла со сведениями об игруш-ках: название игрушки, ее стоимость и возрастные границы, и выполняющую из-менение данных и поиск по названию игрушек, цена которых не превышает 2000 руб. и которые подходят детям до 4 лет. благодарю за внимание! Жду ответа)

Отправлен: 05.06.2008, 23:56 Вопрос задал: Лиза Аринина Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиза Аринина! Решение задачи с комментариями в приложении. Приложение: uses crt; type Tigr=record {тип запись с полями} nam:string[20]; {название} stm:word; {стоимость} vz1:byte; {нижний возраст} vz2:byte; {верхний возраст} end; var sp:array[0..100] of Tigr; {массив записей, список игрушек} f:file of Tigr; {типизированный файл} nz:string[20]; {переменная при смене или поске названия} cn:word; {переменная при поиске или смене цены} v1,v2:byte; {переменные при поиске или смене возраста} n,i,k:byte; {разные счетчики} c:char; {символ при выходе из цикла} label 1,2; {метки-указатели что делать дальше} begin clrscr; {Sozdanie faila} assign(f,'igr.dat'); {} rewrite(f); {} n:=0; repeat writeln('Igrushka ',n); {заносим данные в массив} write('Nazvanie: ');readln(sp[n].nam); write('Cena: ');readln(sp[n].stm); write('Min vozrast: ');readln(sp[n].vz1); write('Max vozrast: ');readln(sp[n].vz2); {два раза Enter} write(f,sp[n]); {записываем в файл} c:=readkey; {если выходим, нажимаем Esc} n:=n+1; until c=#27; close(f); {Vyvod svedenij iz faila} clrscr; reset(f); n:=0; while not eof(f)do begin read(f,sp[n]);{читаем данные из файла и выводим на экран} writeln(sp[n].nam,' Cena ',sp[n].stm,' ot ',sp[n].vz1,' do ',sp[n].vz2); n:=n+1; end; readln; writeln; {Vnesenie izmenenij} writeln('Vnesti izmenenia? 0/1'); readln(i); if i=1 then goto 1 {если вводи 0 идем дальше, 1-вносим ихменения} else if i=0 then goto 2; 1:write('Izmenit zapis i=');readln(i);{nachalo s 0} write('Nazvanie: ');readln(nz); write('Cena: ');readln(cn); write('Min vozrast: ');readln(v1); write('Max vozrast: ');readln(v2); Seek(f,i); {указатель на запись, которую изменяем, нумерация с 0} sp[i].nam:=nz; sp[i].stm:=cn; sp[i].vz1:=v1; sp[i].vz2:=v2; write(f,sp[i]); {Proverka izmenenij} writeln('Fail posle izmenenij:'); reset(f); n:=0; while not eof(f)do begin read(f,sp[n]); writeln(sp[n].nam,' Cena ',sp[n].stm,' ot ',sp[n].vz1,' do ',sp[n].vz2); n:=n+1; end; writeln; writeln('Prodolzit izmenenia? 0/1'); readln(i); if i=1 then goto 1 else if i=0 then goto 2; readln; close(f); {Poisk igrushki} 2:reset(f); write('Nazvanie igrushki: ');readln(nz);{вводим название} n:=0;k:=0; while not eof(f)do begin read(f,sp[n]); if {если все условия соблюдаются, то выводим на экран} (sp[n].nam=nz)and(sp[n].stm<=2000)and(sp[n].vz1<=4)and(sp[n].vz2>=4)then begin writeln(sp[n].nam,' Cena ',sp[n].stm,' ot ',sp[n].vz1,' do ',sp[n].vz2); k:=k+1; end; n:=n+1; end; {если совпадений нет, сообщаем} if k=0 then writeln('Takih igrushek net!'); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 07.06.2008, 14:09

Вопрос № 139.252

Здраствуйте эксперты! Напишите пожалуйста задачку на Паскале: Даны действительные числа a, b и c. Получить (max(a,a+b)+max(a,b+c))/(1+(max(a+b*c,1.15))) путем подключения к основной программе созданного модуля и вызова его подпрограммы, вычисляющей максимум среди заданных значений. Заранее благодарю)

Отправлен: 06.06.2008, 01:01 Вопрос задал: Jokerz Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Jokerz! Создание модуля в двух словах. Открываете новое окно, пишите Unit (имя модуля, оно же имя файла *pas) Interface Здесь описываете константы, типы, и пишете заголовки функций и процедур. Implemetation Здесь подробно описываете функции и процедуры. End. С модулеи все. Сейчас этот файл нужно обычным способом сохранить под тем же именем, что и имя Юнита. Затем нажать Ctrl+F9, выйдет окно с предложением. Выбрать OK. Ваш файл сохранится еще раз, но уже с расширением *tpu. Это и будет модуль. Сейчас поместив его в одну папку с программами, которые его будут использовать, можете с ним работать, для чего в начале каждой программы в разделе Uses нужно указать его имя, как CRT,GRAPH и др. Коды в приложении. Приложение: Модуль. unit max2; interface function Max(a,b:real):real; implementation function Max(a,b:real):real; begin if a>b then Max:=a else Max:=b; end; end. Программа. uses crt,Max2; var a,b,c,y:real; begin clrscr; write('a=');readln(a); write('b=');readln(b); write('c=');readln(c); y:=(Max(a,a+b)+Max(a,b+c))/(1+Max(a+b*c,1.15)); writeln('y=',y:5:3); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 14:58

Вопрос № 139.254

здравствуйте,помогите пожалуйста составить блок схему нахождения суммы цифр числа

Отправлен: 06.06.2008, 01:30 Вопрос задал: Kristina Tamberg Igorevna Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Kristina Tamberg Igorevna! Блок-схема сделана в редакторе, перерисуйте, а то она не похожа на живую, и лишняя линия. По сути все правильно, прилагаю код, по которому схема строилась. Схема в приложенном файле. Код в приложении. Приложение: program sum_cif; uses crt; var n:longint; u,sum:integer; begin clrscr; write('n=');readln(n); {вводим число типа Longint} sum:=0; while n>0 do begin u:=n mod 10; {отделяем последнюю цифру} sum:=sum+u; {прибавляем ее} n:=n div 10; {берем число без последней цифры} end; { и так, пока не будет ноль} writeln('sum=',sum); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 06.06.2008, 15:22

Вопрос № 139.328

Здравсвуйте, уважаемые эксперты! Сегодня две задачки: 1. У натурального числа вычисляют произведение цифр, после этого повторяют операцию, пока не получится однозначное число. Назовём это число характеристикой, а общее количество итераций - глубиной. Выведите в порядке возрастания все числа на отрезке [a, b] с нулевой характеристикой, у которых глубина максимальна. 10 80 55 59 69 78 2. С клавиатуры вводятся два натуральных числа a и b. Распечатайте все числа Армстронга на отрезке [a, b]. 400 2000 407 1634 Какие ошибки у меня в решениях? Заранее благодарен. Коды в приложении. Приложение: 1 Задача Var a, b, i, max_glub: Integer; Procedure ReadDate; Begin ReadLn(a, b); End; Function ChipherHar(i: Integer): Integer; Var x: Integer; Begin x := 1; Repeat While (i <> 0) Do Begin x := (i Mod 10)*x; i := i Div 10; End; i := x; Until (i < 10); ChipherHar := x; End; Function ChipherGlub(i: Integer): Integer; Var x, k: Integer; Begin x := 1; k := 0; Repeat While (i <> 0) Do Begin x := (i Mod 10)*x; i := i Div 10; End; i := x; Inc(k); Until (i < 10); ChipherGlub := k End; Procedure WriteDate; Begin Write(i, ' '); End; Begin max_glub := 0; For i := a To b do begin If ((ChipherHar(i) = 0) And (ChipherGlub(i) > max_glub)) Then begin max_glub := ChipherGlub(i); End; End; For i := a To b Do Begin If ((ChipherHar(i) = 0) And (ChipherGlub(i) = max_glub)) Then begin Write(i, ' '); End; End; ReadLn; End. 2. задача Var i, a, b: Integer; Procedure ReadDate; Begin ReadLn(a, b); End; Function Pow(i, k: Integer): Integer; Var t: Integer; Begin t := i; For i := 1 To k Do Begin i := i*t; End; Pow := i; End; Function ChipherCount(i: Integer): Integer; Var k: Integer; Begin k := 0; While (i <> 0) Do Begin Inc(k); i := i Div 10; End; ChipherCount := k; End; Function ChipherSum(i: Integer): Integer; Var sum: Integer; Begin sum := 0; While (i <> 0) Do Begin sum := sum+Pow(i Mod 10, ChipherCount(i)); i := i Div 10; End; ChipherSum := sum; End; Procedure WriteDate; Begin WriteLn(i); End; Procedure Solve; Begin For i := a To b Do Begin If (ChipherSum(i, ChipherCount(i)) = i) Then Begin WriteDate; End; End; End; Begin Solve; ReadLn; End.

Отправлен: 06.06.2008, 15:05 Вопрос задал: Хощенко Артём Владимирович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хощенко Артём Владимирович! Вторая задача в приложении. Ваши ошибки: - Чему равны А и В когда начинается цикл? Кто будет вызывать п/п ReadDate;. - п/п Pow - считает почти факториал, а не степень. - п/п ChipherSum - проверьте параметры с какими вызывается п/п Pow на втором шаге цикла. Код не коментировал т.к. это Ваша задача. Удачи! Приложение: Var i, a, b: Integer; Procedure ReadDate; Begin write('A:');ReadLn(a); write('B:');readln(b); End; Function Pow(i, k: Integer): Integer; Var t: Integer; Begin t := 1; repeat t := i*t; dec(k); until k=0; Pow := t; End; Function ChipherCount(i: Integer): Integer; Var k: Integer; Begin k := 0; While (i <> 0) Do Begin Inc(k); i := i Div 10; End; ChipherCount := k; End; Function ChipherSum(i: Integer): Integer; Var sum,a: Integer; Begin sum := 0; a:=ChipherCount(i); While (i <> 0) Do Begin sum := sum+Pow(i Mod 10,a); i := i Div 10; End; ChipherSum := sum; End; Procedure WriteDate; Begin WriteLn(i); End; Procedure Solve; Begin For i := a To b Do Begin If (ChipherSum(i) = i) Then Begin WriteDate; End; End; End; Begin ReadDate; Solve; write('Stop'); ReadLn; End. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 06.06.2008, 17:49

Вопрос № 139.428

Здравствуйте уважаемые эксперты, вновь я обращаюсь за вашей помощью, у меня есть задачка: Даны действительные числа A, B, C. Удвоить эти числа, если A >= B >= C, и заменить их абсолютными значениями, если это не так. Я не могу разобраться как изобразить то что "если А >=b>=C" так вот не возможно, та и так я не полностью пойму задачу... Искренне надеюсь на вашу помощь. Заранее огромное спасибо. Приложение: program magazine; uses crt; var a,b,c: real; begin clrscr; Textcolor(yellow); Writeln('‚ўҐ¤ЁвҐ A'); Readln(a); Writeln('‚ўҐ¤ЁвҐ B'); Readln(b); Writeln('‚ўҐ¤ЁвҐ C'); Readln(c); end.

Отправлен: 07.06.2008, 12:04 Вопрос задал: Пашков Дмитрий Владимирович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: -=Dr. Штопор=- Здравствуйте, Пашков Дмитрий Владимирович! После запроса исходных данных делаем следующее: {продолжаю с того места, где Вы закончили} IF (a>=b) AND (b>=c) THEN BEGIN a:=a*2; b:=b*2; c:=c*2; END ELSE a:=abs(a); b:=abs(b); c:=abs(c); END; write(a,b,c); {Дальше только END c точкой :) } --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 9-ый класс) Ответ отправлен: 07.06.2008, 12:12

Вопрос № 139.430

Здравствуйте! Очень прошу помочь,у друга сейчас экзамен и надо выполнить задание:написать программу для ввода последовательности чисел, в которой 0 - конец последовательности. Подсчитать сколько в ней отрицательных чисел. P.s. Заранее благодарен!!

Отправлен: 07.06.2008, 12:10 Вопрос задал: Saiks Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан / Marked O Здравствуйте, Saiks! Задача с пояснениями в приложении. Главное в этой прграмме - цикл repeat...until. Он имеет такой вид: repeat тело цикла until условие Тело цикла - произвольная последовательность операторов, которые будут повторятся, пока не выполнено условие Операторы тела цикла выполняются хотя бы один раз, потом проверяется условие, если оно не выполняется, то тело цикла повторяется, иначе цикл завершает свою работу. Удачи!!! Приложение: var {count-Кол-во отриц чисел, n-число} count, n: integer; begin {Обнуляем кол-во отр. чисел} count:=0; {Пока число не равно 0, повторяем} repeat {Получам число} Write('Введите число: '); readln(n); {Если оно отр. то увеличиваем счетчик на 1} if n<0 then inc(count); until n=0; {Выводим рез-тат} Write('Кол-во отр. чисел: ', count); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked O (статус: Студент) Ответ отправлен: 07.06.2008, 18:27

Вопрос № 139.431

Для делимости числа на 5 необходимо, чтобы последняя цифра числа была 0 или 5. Написать функцию проверки делимости числа n, вводимого с клавиатуры, на 5.

Отправлен: 07.06.2008, 12:39 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Абельхарисов Руслан / Marked O Здравствуйте, Пухов Никита Евгеньевич! Функция и программа использующая её в приложении. Удачи!!! Приложение: {Функция, принимает строку содержащую число, возвращает true, если число делится на 5, иначе возвращает false} function Five(n: string): boolean; begin {Если полследняя цифра равна 5 или 0, то возвращаем true, иначе false} if (n[length(n)]='5') or (n[length(n)]='0') then Five:=true else Five:=false; end; var str: string; begin Write('Введите число: '); ReadLn(str); if Five(str) then Write('Число ', str, ' делится на 5') else Write('Число ', str, ' не делится на 5'); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked O (статус: Студент) Ответ отправлен: 07.06.2008, 18:13

Отвечает: SHERRY Здравствуйте, Пухов Никита Евгеньевич! Вот более простой способ. Предполагаем, что число при делении на 5 даст в остатке нуль. А программа определит правильность нашего предположения и передаст функции результат логического типа (boolean) Функция вернёт TRUE, если число делится на 5 и FALSE в противном случае. Код в приложении. Приложение: function ok(var ch: integer): boolean; begin ok:= (ch mod 5) = 0; end; {Пример использования} var a: integer; begin readln(a); writeln(ok(a)); readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 08.06.2008, 00:52

Вопрос № 139.433

Дана целочисленная прямоугольная матрица. Определить номер строки и столбца максимального элемента данной матрицы (оформить в виде процедуры).

Отправлен: 07.06.2008, 12:42 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Пухов Никита Евгеньевич! Вопрос здесь уже "родной". Программа в приложении. Приложение: Program Pr139433; Uses CRT; Const N = 10; M = 12; { Размерность матрицы } Var i, j : Integer; Matr : Array[1..N, 1..M] of Integer; Procedure FindMax; var i, j : Integer; Min_i, Min_j: Integer; begin Min_i := 1; Min_j := 1; { индексы максимального элемента } for i := 1 to N do for j := 1 to M do if Matr[i, j] > Matr[Min_i, Min_j] then begin Min_i := i; Min_j := j; end; Write('Максимальный элемент: Matr[', Min_i, ',', Min_j); WriteLn('] = ', Matr[Min_i, Min_j]); end; Begin ClrScr; Randomize; WriteLn('Исходная случайно заполненная матрица:'); WriteLn; for i := 1 to N do begin for j := 1 to M do begin Matr[i, j] := Random(1000); Write(Matr[i, j]:5); end; WriteLn; WriteLn; end; FindMax; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 07.06.2008, 13:25

Вопрос № 139.435

В записной книжке записаны фамилии и номера телефонов 30 человек. Определить, есть ли в записной книжке: - Телефон некоторого человека, и если есть, то вывести этот номер телефона. - Человек с заданным номером телефона, и если есть, то вывести фамилию.

Отправлен: 07.06.2008, 12:45 Вопрос задал: Пухов Никита Евгеньевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пухов Никита Евгеньевич! Один из многих возможных вариантов решения этой задачи в приложении. При тестировании примите n поменьше, типа 3, 5. Приложение: uses crt; const n=30; type Tzap=record {тип запись с полями по условию} fam:string[20]; tel:string[20]; {номер телефона лучше строкой, т.к. есть разные виды записи номеров} end; var sp:array[1..n]of Tzap; {массив записей-записная книжка} i,k:integer; fm,tl:string[20]; {переменные при поиске фамилий и телефонов} label 1,2,3,4; {метки-указатели что делать дальше} begin clrscr; for i:=1 to n do {заполняем массив} begin writeln('Abonent ',i); write('Familia: ');readln(sp[i].fam); write('Telefon: ');readln(sp[i].tel); end; clrscr; 1:writeln('Iskat # telefona? 1; Familiu? 2; Vyjti? 3');{меню} readln(i); if i=1 then goto 2 else if i=2 then goto 3 else if i=3 then goto 4; 2:write('Vvedite familiu: ');readln(fm); {поиск телефона по фамилии} k:=0; for i:=1 to n do if sp[i].fam=fm then begin writeln('Nomer telefona ',sp[i].tel); k:=k+1; end; if k=0 then writeln('Takogo telefona net!'); readln; writeln; goto 1; 3:write('Vvedite nomer telefona: ');readln(tl);{поиск фамилии по телефону} k:=0; for i:=1 to n do if sp[i].tel=tl then begin writeln('Familia ',sp[i].fam); k:=k+1; end; if k=0 then writeln('Takoj familii net!'); readln; writeln; goto 1; 4:exit; {выход} end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 07.06.2008, 18:41

Вопрос № 139.436

Уважаемые эксперты, пожалуйста помогите решить задачу, я даже не могу понять с чего сдесь начать, может сдесь нужно с помощью цикла? Я задачу сохранил скриншотом на рисунке, адрес которого указа в приложении, искренне надеюсь на вашу помощь. Пожалуйста. Заранее спасибо. Приложение: http://k750i.wen.ru/676.JPG

Отправлен: 07.06.2008, 12:48 Вопрос задал: Пашков Дмитрий Владимирович Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Delph Здравствуйте, Пашков Дмитрий Владимирович! Решение Вашей задачки в приложении. Единственное, что меня удивило - сумма почему-то стремится к нулю. Если такого быть не должно, сообщите, буду ломать голову дальше. Приложение: Program Pr139436; Uses CRT; Var x, eps, p, sum: Real; k: Integer; Begin ClrScr; Write('eps = '); ReadLn(eps); Write('x = '); ReadLn(x); if eps < 1e-10 then eps := 1e-10; { eps > 0 всегда! } p := x; k := 0; sum := 0; While abs(p / (2*k + 1)) > eps do begin sum := sum + p / (2*k + 1); inc(k); p := - p * x*x / k; end; WriteLn('Summa = ', sum); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 07.06.2008, 14:12

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пашков Дмитрий Владимирович! В приложении мое решение этой задачи, выполненное точно по условию. Проверил при х от 0,1 до 1 в Excel. Все сходится и что удивительно сумма к нулю не стремится. Просто при малых х она мало изменяется и нужно брать очень высокую точность, до 8-9 знака, чтобы почуствовать разницу. При х=1, разница при различных е более заметна. Приложение: uses crt; var k:word; x,e,sum,y:double; function fakt(t:word):longint;{функция факториал} var i,n:integer; begin n:=1; for i:=1 to t do n:=n*i; fakt:=n; end; function Step(a:real;b:word):real;{функция степень} var i:integer;n:real; begin n:=1.0; for i:=1 to b do n:=n*a; Step:=n; end; begin {начало программы} clrscr; repeat write('Vvedite 0<x<=1 x='); {проверяем правильность ввода х} readln(x); until (x>0)and(x<=1); write('e=');readln(e); k:=0;y:=step(x,2*k+1)/(fakt(k)*(2*k+1));sum:=y; while y>=e do {пока очередной элемент<e} begin k:=k+1; y:=step(x,2*k+1)/(fakt(k)*(2*k+1)); if k mod 2=0 then sum:=sum+y {если номер положительный} else if k mod 2<>0 then sum:=sum-y; {если отрицательный} end; writeln('Summa=',sum:5:5); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 07.06.2008, 16:40

Вопрос № 139.451

Помогите решить задачку, пожалуйста: Информация о средней суточной температуре воздуха за месяц задана в воде массива. Определить температура скольких дней была ниже среднемесячной(Код этой программы есть но, он не правельно считает, не могу понять по чему) Приложение: program PR10Z1; {$APPTYPE CONSOLE} uses SysUtils; Var a:array[1..30] of integer; s,n,i,p:integer; sm:real; begin randomize; Writeln(' ------------------------------------ '); Writeln('| Sredn. sutochnaya temp-ra za Aprel |'); Writeln(' ------------------------------------ '); Writeln; n:=1; For i:=1 to 30 do a[i]:=random(15)-5; For i:=1 to 30-9 do begin While n<=9 do begin a[i]:=random(15)-5; Writeln('0',n,' Aprelya: ',a[i]); n:=n+1; end; Writeln(n,' Aprelya: ',a[i]); n:=n+1; end; s:=0; For i:=1 to 30 do s:=s+a[i]; sm:=s/30; Writeln; Writeln('Summa za mecyac:',s); Writeln('Sredne mesyachnaya temp-ra: ',sm:2:0); Writeln; For i:=1 to 30 do If a[i]<sm then Writeln(n,' Aprelya'); readln; end.

Отправлен: 07.06.2008, 15:14 Вопрос задал: Proks Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан / Marked O Здравствуйте, Proks! У Вас несколько ошибок: Правильнее будет не так: Writeln(' ------------------------------------ '), а так Writeln(' ------------------------------------ ') Вы ввели символ '' не в кавычках в нескольких местах программы. Вы пишете:  For i:=1 to 30 do   If a[i] < sm then Writeln(n,' Aprelya'); И соответственно у Вас всегда выводится: 31 Aprelya 31 Aprelya 31 Aprelya ... Это потому что вы выводите переменную n, которая хранит не число месяца, она используется при выводе массива. Вам надо вывести число месяца, а его хранит переменная i, которая используется при сравнении температур со среднемесячной. Вот правильный вариант:  For i:=1 to 30 do   If a[i] < sm then Writeln(i,' Aprelya'); Я рискнул заново сделать вашу задачу, она с объяснениями в приложении. Удачи!!! Приложение: program PR10Z1; {$APPTYPE CONSOLE} Var {массив температур} a: array [1..30] of integer; {i-счетчик для For, sum-сумма температур, count-кол-во дней когда температура была ниже средней} i, sum, count: integer; {Средняя температура} sr: real; begin {Инициализируем генератор случайных чисел} randomize; {Обнуляем сумму и кол-во} sum:=0; count:=0; {В цикле перебираем весь массив и...} for i:=1 to 30 do begin {...Заполняем его сл. числами} a[i]:=random(15)-5; {Выводим температуру} Writeln('April ', i:2, ': ', a[i]:2); {Прибавляем к сумме для выч. средней температуры} sum:= sum + a[i]; end; {Вычисляем среднюю} sr:=sum/30; {Выводим сумму температур и среднюю температуру} WriteLn('Summa T: ', sum); WriteLn('Srednaa T: ', sr:6:3); {В цикле проверяем,} for i:=1 to 30 do {ниже ли температура среднемесячной} if a[i] < sr then begin {Если да, то выводи её} WriteLn('April ', i, ': ', a[i]:2); {И увеличиваем на 1 счетчик} inc(count); end; {Выводим кол-во дней когда температура была ниже среднемесячной} WriteLn('Temperature of ', count, ' days was under ', sr:6:3); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked O (статус: Студент) Ответ отправлен: 07.06.2008, 17:58

Вопрос № 139.496

Программа ищет максимальный отрицательный элемент из целочисленного массива должна состоять из 2х модулей модули сделал скомпиллировал подключил в директориях все прописал итд итп пишет несоответствие типов выходного из процедуры массива, причем процедура только отбирает из исходного массива отрицательные элементы. Что я делаю не так) Приложение: unit M1P1; interface const p = 10; type mas = array[1..p] of integer; procedure poe(n1: integer; a1: mas; var b2: mas; var a2: mas; var n2: integer); implementation procedure poe; var i: integer; begin n2:=0; for i:= 1 to n1 do if a1[i]<0 then begin inc(n2); a2[n2]:=a1[i]; b2[n2]:=i; end; end; end. unit M2P1; interface const p = 10; type mas = array[1..p] of integer; function plm (c2: integer; a2: mas): integer; implementation function plm; begin c2:=0; repeat inc(c2) until ((a2[c2-1]<a2[c2]) and (a2[c2] > a2[c2+1])); plm:=c2; end; end. program SLmod12; uses M1P1,M2P1; const p=10; type mas = array[1..p] of integer; var k,n,i,c: integer; a,b,d: mas; begin writeln('Dlinna vxod massiva'); readln(n); writeln('vvedite massiv'); for i:= 1 to n do readln(a[i]); poe(n, a, d, b, c); k:=plm(c,b); writeln('maksimum: ',d[k]); readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Shtirlic! Главная Вваша ошибка то, что Вы для преобразоваий и вычислений в одном массиве создаете два модуля. В итоге объявленный в этих модулях тип массива, написанный одинаково, и, как Вам кажется это одно и тоже, для программы это два разных типа, т.к. это типы пользовательские. Естественно программа не может определиться с типом и пишет о его несоответствии. А решать половину задачи с одним типои, а вторую с другим, нельзя . Скорее всего Вы неправильно поняли задание. Вам вероятно задали создать модуль, в котором нужно предусмотреть две процедуры или функции. То что Вы скомпилировали модули в том виде как Вы их нам написали, неправда, там такие ошибки, при которых ни о какой компиляции и речи быть не может, хотя бы то что в интерфейсном разделе и в исполняющей части процедура и функция записаны по разному. Короче я написал модуль и программу под него, стараясь сохранить по возможности Ваш стиль, посмотрите. Если с чем несогласны или что непонятно, пишите на мини-форуме. Да, чуть не забыл, не задавайте в модуле размер массива константой, иначе Вы не сможете изменить его размер в программе, а это часто приходится делать. Коды модуля и программы в приложении. Приложение: Модуль. unit M1P1; interface type mas=array[1..100]of integer; procedure poe(n1:integer;a1:mas;var n2:integer;var a2:mas); function plm(n2:integer;a2:mas):integer; implementation procedure poe(n1:integer;a1:mas;var n2:integer;var a2:mas); var i:integer; begin n2:=0; for i:=1 to n1 do if a1[i]<0 then begin inc(n2); a2[n2]:=a1[i]; end; end; function plm(n2:integer;a2:mas):integer; var i,max:integer; begin max:=a2[1]; for i:=2 to n2 do if a2[i]>max then max:=a2[i]; plm:=max; end; end. Программа. program SLmod12; uses crt,M1P1; var a,b:mas; i,p,n,mxotr:integer; begin clrscr; write('p=');readln(p); writeln('Ishodnyj massix:'); for i:=1 to p do read(a[i]); readln; poe(p,a,n,b); writeln; writeln('Massiv otricatelnyh chisel:'); for i:=1 to n do write(b[i],' '); writeln; writeln('Maximum sredi otricatelnyh=',plm(n,b)); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 08.06.2008, 11:51

Отвечает: Denisss Здравствуйте, Shtirlic! Вся проблема в том, что Вы в каждом модуле объявляете свой тип mas и свою собственную константу p. Этого делать не нужно. В приложении находится пример того, как объявить всего один тип mas в единственном модуле, а затем использовать этот тип в разных модулях. В примере тип mas объявляется в модуле M1P1. Удачи! Приложение: ====== SLmod12.PAS ====== program SLmod12; uses M1P1,M2P1; var k,n,i,c: integer; a,b,d: mas; begin writeln('Dlinna vxod massiva'); readln(n); writeln('vvedite massiv'); for i:= 1 to n do readln(a[i]); poe(n, a, d, b, c); k:= plm(c,b); writeln('maksimum: ', d[k]); readln; end. ====== M1P1.PAS ====== unit M1P1; interface const p = 10; type mas = array[1..p] of integer; procedure poe(n1: integer; var a1: mas; var b2: mas; var a2: mas; var n2: integer); implementation procedure poe; var i: integer; begin n2:=0; for i:= 1 to n1 do if a1[i]<0 then begin inc(n2); a2[n2]:=a1[i]; b2[n2]:=i; end; end; end. ====== M2P1.PAS ====== unit M2P1; interface uses M1P1; function plm (c2: integer; a2: mas): integer; implementation function plm; begin c2:=0; repeat inc(c2) until ((a2[c2-1]<a2[c2]) and (a2[c2] > a2[c2+1])); plm:=c2; end; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 08.06.2008, 12:08

Вопрос № 139.516

Здраствуйте уважаемые эксперты!...Помогите пожалуста составить прогу, одну с операторами присваивания,перехода;вторую с использованием циклов... Найтти сумму ряда: s = 1 - 1/2+ 1/3 - 1/4 + …((-1)^(n+1)) 1/n с заданой точностю E=10^-4.

Отправлен: 08.06.2008, 11:24 Вопрос задал: Китаев Кирилл Артурович Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Китаев Кирилл Артурович! Решение задачи на циклы в приложении. Объясните подробнее что такое "одну с операторами присваивания,перехода;". Приложение: uses crt; var s,e,a:real; i:integer; begin clrscr; s:=1;i:=0;e:=0.0001;a:=1/(i+1); while a>=e do {пока очередной элемет ряда больше е} begin i:=i+1; {добавляем счетчик} a:=1/(i+1);{считаем очередной элемент} if odd(i) then s:=s-a{если iнечетное-вычитаем} else s:=s+a;{если четное-прибавляем} end; writeln('s=',s:1:5); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 08.06.2008, 12:19

Отвечает: Denisss Здравствуйте, Китаев Кирилл Артурович! Примеры с комментариями находятся в приложении. Отдельно поясню строку n:= Trunc(1/E) + 1; Здесь определяется n, при которой s рассчитывается с точностью E. В данном примере точность определяется элементом 1/n. Т.е. при ( 1/n < E ) или при ( n > 1/E, 0 < E ) выполняется поставленное условие. Функция Trunc возвращает целую часть от деления 1/Е, а прибавление 1 дает нам гарантию, что n будет всегда больше 1/E. Далее остается только организовать цикл от 1 до n и сосчитать s. Успехов! Приложение: ====== С применением цикла for ====== Program Q139516_1; var s: Real; n, i: Integer; const E: Real = 1e-4; { 10^-4 } begin {Определяем последнюю n} n:= Trunc(1/E) + 1; {Инициализация} s:= 0; {Цикл} for i:= 1 to n do begin {Если четное} if not odd(i) then {Вычитаем} s:= s - 1/i else {Иначе прибавляем} s:= s + 1/i; end; {Выводим результат} writeln('s = ', s:1:6); {Ожидаем нажатия Enter от пользователя} readln; end. ===== С применением оператора перехода Goto ===== Program Q139516_2; var s: Real; n, i: Integer; const E: Real = 1e-4; { 10^-4 } label loop; begin n:= Trunc(1/E) + 1; {Инициализация} s:= 0; i:= 1; loop: {Прибавляем} s:= s + 1/i; {Увеличиваем i и меняем ей знак} if (i > 0) then i:= -i-1 else i:= -i+1; {Если еще не получена заданная точность, переходим в начало } if (abs(i) <= n) then goto loop; {Выводим результат} writeln('s = ', s:1:6); {Ожидаем от пользователя нажатия ввода} readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 08.06.2008, 14:09

Вопрос № 139.530

уважаемые эксперты!!очень прошу помочь мне в решении этой нелегкой задачи:) Траектория снаряда, вылетающего из орудия под углом а с начальной скоростью v0 описывается уравне- ниями: x = v0 ·cosа ·t, y = v0 ·sinа ·t – g((t)в квадрате) /2, где g = 9.8 – ускорение сво- бодного падения, t – время. Вводя n пар (v0 , а ), определить, сколько снарядов поразит цель высотой P, расположенной в вертикаль ной плоскости ствола орудия на расстоянии R на высоте H P.S заранее благодарен!!!!!

Отправлен: 08.06.2008, 13:46 Вопрос задал: Петров Игорь Ильич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Петров Игорь Ильич! Для решения задачи использовал тип запись, в котором удобно хранить разнотипную информацию об объекте. Здесь за объект записи принимаем выстрел, а его полями(характеристиками) будут: - угол в градусах - начальная скорость в м/с - время полета снаряда в секундах - координата У в т.Х в метрах Время определяем из приведенной формулы x=v0∙сosа∙t,где за х принимаем R. У также определяем по приведенной формуле y=v0∙sinа∙t–g*t^2/2. Угол везде переводим в радианы по формуле φ=а*pi/180. Результат: если у>H и y меньше P+H , то попадание. Тестировал при R=6000, v0=410, a=[10.5;12] H=40, P=100. Работает. Приложение: uses crt; type Tsnar=record a:real; v0:word; t:real; y:real; end; var sp:array[1..100]of Tsnar; {массив записей - выстрелы} n,i,k:byte; {разные переменные} P,R,H:word; {по условию} begin clrscr; write('Vvedite rasstojanie do cheli R=');readln(R); write('Vvedite vysotu do cheli H=');readln(H); write('Vvedite vysotu cheli P=');readln(P); write('Vvedite kolichestvo vystrelov n='); readln(n); for i:=1 to n do begin writeln('Vystrel ',i); {вводим данные в массив} write('Ugol v grad: ');readln(sp[i].a); write('Nachalnaja skorost: ');readln(sp[i].v0); sp[i].t:=R/(sp[i].v0*cos(sp[i].a*pi/180)); sp[i].y:=sp[i].v0*sin(sp[i].a*pi/180)*sp[i].t-9.8*sqr(sp[i].t)/2; end; writeln; k:=0; for i:=1 to n do if (sp[i].y>H)and(sp[i].y<H+P)then k:=k+1; writeln('Kolichestvo popadanij=',k); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 08.06.2008, 21:53 Оценка за ответ: 5 Комментарий оценки: спсибо!! очень благодарен!!!!!!

Вопрос № 139.532

Составить программу для вычисления суммы ряда с заданной точностью Е , если известна формула для вычисления общего члена ряда ai. ai=((x/3) в степени i) ---------------------------------------------------------------------------------------- P.S. здесь в решении нада както применить вот эту формулу: ((a) в степени i)=exp(i*ln(a)) и погрешность Е мы набираем произвольно с клавиатуры!! ------------------------------------------------------------------------------------------------ заранее очень благодарен!!!!!!!

Отправлен: 08.06.2008, 13:52 Вопрос задал: Петров Игорь Ильич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Denisss Здравствуйте, Петров Игорь Ильич! В приложении находится пример решения поставленной задачи. Насколько я понимаю, должно присутствовать еще одно условие: -3 < x < 3. Возведение в степень в примере реализовано как (x/3)*(x/3)*(x/3)*..., поскольку в данном случае такая реализация будет работать в несколько раз быстрее. Если использование формулы ai = ei*ln(a) является обязательным условием, то: 1. Объявите переменную i типа LongInt: var   a1, a2, E, x, sum: Real;   i: LongInt; 2. Замените строку while (abs(a1)-abs(a2) >= E) do begin на i:= 0; while ((abs(a1)-abs(a2) >= E) and (i < MaxLongInt)) do begin   Inc(i); 3. Замените вторую строку (первую не трогайте) a2:= a1*x; на a2:= exp(i*ln(x)); Но хочу заметит ь, что в таком случае точность найденного значения суммы будет не всегда соответствовать введенному с клавиатуры значению E из-за ограничений на размер типа LongInt. Успехов! Приложение: Program Q139532; uses Crt; var a1, a2, E, x, sum: Real; begin {Вводим Х} repeat write('x (-3.0; 3.0) = '); readln(x); until ((x > -3) and (x < 3)); x:= x/3; {Вводим погрешность} write('E = '); readln(E); if (E < 1e-10) then E:= 1e-10; { E > 0 всегда! } {Первый элемент суммы} a1:= x; sum:= a1; {Второй элемент суммы} a2:= a1*x; {Пока не достигнем указанной точности} while (abs(a1)-abs(a2) >= E) do begin {Суммируем} sum:= sum + a2; {Рассчитываем следующие элементы суммы} a1:= a2; a2:= a1*x; end; {Выводим результат} writeln('sum = ', sum:1:6); {Ожидаем от пользователя нажатия ввода} readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 08.06.2008, 14:57

Вопрос № 139.537

ЗдраствуйТе!...Пишу второй раЗ....Помогите пПлиЗ...очЕн НужНо.. Вот само задание. 1)Число m, составлено из цифр числа n так, что сначало идут четные цыфры чила n , а затем нечетные (в том же порядке что и n)..... 2)Составить эту же прогу,в котром n и m имеют строковой тип 3)(по 1-му заданию)Нужно составить программу вывода на экран по данному числу n типа string матрицу s на s (кол-во цифр в числе m), cостоящию из нулей и цифр числа m,которые расположены в последнем столбце сверху вниз... P.S///РаБОта нужНа именно с масивоМ P.S///Зарание Огромная БлагодарносТЬ!

Отправлен: 08.06.2008, 14:15 Вопрос задал: Китаев Кирилл Артурович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Китаев Кирилл Артурович! Решение всех трех задач с комментариями в приложении. Хорошо видно, что работать с числами в строковом виде иногда намного быстрее и удобнее, чем в числовом их представлении. Главное можно оперировать с числами до 255 знаков. Приложение: Задача 1. uses crt; var n,m:longint; k,u,i,x,j,t:byte; c:array[1..20]of byte; begin clrscr; write('Vvedite chislo <=2 147 483 647 n='); writeln; readln(n); {razlozenie na cifry s konca} k:=0; while n>0 do {пока число не ноль} begin u:=n mod 10; {отделяем последнюю цифру} k:=k+1; {считаем ее} c[k]:=u; {заносим в массив} n:=n div 10; {берем число без последней цифры} end; {цифры в массиве задом наперед} {perevorot} for i:=1 to k div 2 do {от начала до середины меняем первые с последнтми} begin x:=c[i]; c[i]:=c[k-i+1]; c[k-i+1]:=x; end; {chetnye vpered} t:=0; for i:=1 to k do if c[i] mod 2=0 then {если цифра четная} begin t:=t+1; {назначаем ей место, начиная с первого} x:=c[i]; {запоминаем ее} for j:=i downto t+1 do begin c[j]:=c[j-1]; {сдвигаем массив влево на 1, убираем четную цифру} end; c[t]:=x; {ставим на место цифру} end; for i:=1 to k do m:=10*m+c[i]; {формируем из массива чило} writeln; writeln('m=',m); readln end. Задача 2. uses crt; var n,m:string; i,t,c:integer; begin clrscr; write('Vvedite chislo: ');readln(n); m:='';i:=1; while i<=length(n)do begin val(n[i],t,c); {преобразуем символ в цифру} if t mod 2=0 then {если она четная} begin m:=m+n[i]; {переносим ее в число m} delete(n,i,1); {удаляем из n} end else i:=i+1; {если нечетная, переходим к следующей} end; m:=m+n; {приписываем к четным цифрам нечетные} writeln(m); readln end. Задача 3. uses crt; var n,m:string; i,t,c,j:integer; a:array[1..100,1..100]of char;{массив символов} begin clrscr; write('Vvedite chislo: ');readln(n); m:='';i:=1; while i<=length(n)do begin val(n[i],t,c); if t mod 2=0 then begin m:=m+n[i]; delete(n,i,1); end else i:=i+1; end; m:=m+n; writeln(m); {до этого места как в задаче 2} readln; for i:=1 to length(m) do {формируем матрицу} begin for j:= 1 to length(m) do begin a[i,j]:='0'; {заполняем нолями} a[i,length(m)]:=m[i]; {последний столбец-цифры числа m} write(a[i,j]:3); end; writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 09.06.2008, 07:52

Вопрос № 139.548

Помогите, пожалуйста, составить программу. В массив А[N] занесены натуральные числа. Составить программу для определения суммы тех элементов, которые кратны данному К (вводиться с клавиатуры)

Отправлен: 08.06.2008, 15:26 Вопрос задал: Гатауллин Ильдар Рамилович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Гатауллин Ильдар Рамилович! Решение задачи в приложении. Приложение: uses crt; const n=20; var a:array[1..n] of word; K,i,sum:word; begin clrscr; randomize; writeln('Massiv:'); For i:=1 to n do begin a[i]:=random(100); write(a[i],' '); end; writeln; write('Vvedite K=');readln(K); sum:=0; For i:=1 to n do if a[i] mod K=0 then {если кратны К} sum:=sum+a[i]; {то суммируем} writeln('Summa=',sum); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 09.06.2008, 08:23

Вопрос № 139.555

Помогите, пожалуйста, составить программу. Ввести фамилию, имя и отчество как одну велечину строкового типа. Определить длину строки и количество букв "а" в ней. Вывести длины фамилии и имени

Отправлен: 08.06.2008, 16:00 Вопрос задал: Гатауллин Ильдар Рамилович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Гатауллин Ильдар Рамилович! Код и описание Вашей программы в приложении. Приложение: const MyChar = 'k'; {символ, количество вхождений которого нужно подсчитать} var fio: string; {в этой переменной будем хранить считываемую строку} count,i: byte; {вспомогательные переменные: счётчик символов и индекс элементов строки} begin count:= 0; {изначально количество искомых символов равно нулю} readln(fio); {считываем строку} for i:=1 to length(fio) do {в цикле просматриваем символы, начиная с первого и до конца строки} if fio[i] = MyChar then inc(count); {если встретится нужный символ, то счётчик увеличиваем на единичку} writeln('Length of `', fio, '` = ', length(fio), '; count of `', MyChar, '` = ', count); {выводим результат на экран} readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 08.06.2008, 16:25

Вопрос № 139.564

дан файл, содержимое сведения о наличии билетов и рейсах Аэрофлота.Каждая запись содержит поля-номер рейса,пункт назначения, время вылета, время прития, количество свободных мест в салоне. Написать программу, выдающию следущую информацию: -время отправления самалётов в город X; -наличие свободных мест на рейс в город X с временем отправлением Y; -значение книг X,Y вводится по вопросу терминала

Отправлен: 08.06.2008, 16:36 Вопрос задал: Shamil boroda (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Shamil boroda! Код Вашей программы в приложении. Разбирайтесь. Приложение: const path = 'aeroflot.dat'; {путь к файлу с данными} Type TFlot = record {наш тип, в котором описываем данные о рейсе} race, sits: integer; {race - номер рейса, sits - количество свободных мест} finish, start_time, finish_time: string[50]; {finish - пункт назначения, start_time - время вылета, finish_time - время прибытия} end; var BD: file of TFlot; {файловая переменная типа TFlot (см. описание типа выше)} k: TFlot; {переменная типа TFlot} x, y: string[50]; {пункты X и Y для поиска по базе} NoRezult: boolean; {признак существования результата поиска} procedure CreateBD; {процедура создания файла с базой данных} var s: TFlot; begin writeln('Please, type your data. For end - type race number 666.'); Rewrite(BD); {создаём файл (он пока что пуст)} Repeat {заполняем файл данными о рейсах. признак окончания - рейс номер 666} write('Input number of race '); readln(s.race); {считываем номер рейса} if s.race = 666 then exit; {признак окончания считывания информации} write('Input finish '); readln(s.finish); {считываем пункт назначения} write('Type start time (hh:mm) '); readln(s.start_time); {считываем время вылета} write('Type finish time (hh:mm) '); readln(s.finish_time); {считываем время прибытия} write('Type number of sits '); readln(s.sits); {считываем количество свободных мест} write(BD, s); {записываем считанные данные в файл} writeln; Until s.race = 666; end; begin Assign(BD, path); {задаём файловой переменной BD файл на диске, по адресу из константы path} if FileExists(path) then {если файл по заданному пути существует, то мы можем приступить к работе с ним, или же создать новый файл} begin write('File ',path, ' is already exists. Do you want to use it? (Yes/No) '); {запрос на создание нового файла с базой данных} readln(x); if x = 'No' then CreateBD; end else CreateBD; {если файл по заданному адресу не существует, то запускаем процедуру его создания} Reset(BD); {открываем файл для чтения} write('Please, type X '); readln(x); {считываем значения X и Y} write('Please, type Y now '); readln(y); NoRezult:= true; {предполагаем, что поиск не даст результата} While not EOF(BD) do {до тех пор, пока не достигнут конец файла} begin read(BD, k); {считываем из файла данные о рейсе} if k.finish = x then {если данные удовлетворяют условиям Вашего запроса, то выведем их на экран} begin write(k.finish, ' ', k.start_time); if k.start_time = y then write(' ', k.sits); NoRezult:= false; {признак существования результата поиска} writeln; end; end; if NoRezult then writeln('Nothing found..'); {если поиск не дал результатов, то выведем соотв. сообщение} Close(BD); {закрываем файл с базой данных} readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 08.06.2008, 19:52 Оценка за ответ: 5

Вопрос № 139.583

ПЛИЗ HELP !!!Дан одномерный массив A[N].Составить программу для подсчета количества отрицательных, положительных и нулевых элементов в массиве.

Отправлен: 08.06.2008, 18:53 Вопрос задал: Гатауллин Ильдар Рамилович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станислав Васильевич Здравствуйте, Гатауллин Ильдар Рамилович! Программа в приложении Удачи!!! Приложение: const n=100; Var A:array[1..n] of integer; Z,X,Y:word; I:word; Begin Randomize; x:=0; y:=0; z:=0; Fir i:=1 to n do a[i]:=random(200)-Random(200); For i:=1 to n do If a[i]>0 then inc(x) else If a[i]=0 then inc(y) else inc(z); Writeln('Чисел >0 ',x,' Чисел = 0',y,' Чисел <0',z); REadln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 7-ой класс) Ответ отправлен: 08.06.2008, 19:40

Вопрос № 139.635

Даброго времени суток уважаемые эксперты. Help me. Нужно из символного массива выделить цифры. Как это сделать? Заранее спосибо!

Отправлен: 09.06.2008, 10:24 Вопрос задал: Носиров Мансур (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Носиров Мансур! В приложении - программа, демонстрирующая один из способов решения Вашей задачи. Приложение: Program Pr139635; Uses CRT; Const N = 32; Type TCharsArray = Array[1..N] of Char; { Функция выделяет цифры из символьного массива } function Numbers(Ch_Arr: TCharsArray): String; var str: String; i : Integer; begin str := ''; for i := 1 to N do if Ch_Arr[i] in ['0'..'9'] then str := str + Ch_Arr[i]; Numbers := str; end; { Пример использования функции } Var CharsArr: TCharsArray; i : Integer; Begin ClrScr; Write('Введите массив символов: '); for i := 1 to N do begin CharsArr[i] := ReadKey; Write(CharsArr[i]); end; WriteLn; WriteLn('Цифры из массива: ', Numbers(CharsArr)); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 09.06.2008, 11:34

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