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

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

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

Шичко Игорь Статус: Практикант Рейтинг: 184 ∙ повысить рейтинг >>

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

Verena Статус: Специалист Рейтинг: 115 ∙ повысить рейтинг >>

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

Выпуск № 753
от 12.12.2008, 22:35

Вопрос № 153275: - С помощью логической переменной определите: есть ли в записи пятизначного числа четные цифры. · В первый год было выращено 0.5 кг шиповника. На каждый последующий год сбор урожая увеличивается на 4% от предыдущего урожая. Каким будет...

Вопрос № 153.275

- С помощью логической переменной определите: есть ли в записи пятизначного числа четные цифры. · В первый год было выращено 0.5 кг шиповника. На каждый последующий год сбор урожая увеличивается на 4% от предыдущего урожая. Каким будет урожай шиповника на 4-й год? 8‑й год? 12-й год? · В ЭВМ вводятся по очереди координаты n точек. Определить, сколько из них попадет в круг с радиусом R с центром в точке (a, b). · Задан список участников соревнования по плаванию и их результаты. Напечатать фамилию и результат чемпиона. (Даны два массива: для фамилий и для результатов.) · Дана действительная матрица размером n*m. Найти сумму наименьших значений элементов строк. Отсортировать матрицу по возрастанию. Составить блок-схему алгоритма. Напечатайте заданную последовательность символов, заменяя каждую точку многоточием.

Отправлен: 07.12.2008, 06:58 Вопрос задал: Кувалдин Алексей Юрьевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Костя Симанович Здравствуйте, Кувалдин Алексей Юрьевич! Варианты решения некоторых задачь в приложении с пояснениями. Первая задача решена с использованием переменной типа boolean, хотя её можно решить и без дополнительной переменной. Надеюсь помог. Удачи. Приложение: задача №1 program chislo; var a : longint; a1 : integer; b : boolean; begin writeln('Введите 5 значное число.'); readln(a); while a <> 0 do begin b := false; // цифра нечетная a1 := a mod 10; // получаем остаток от деления на 10, (последняя цифра) a := a div 10; // отбрасываем последнее число if (a1 mod 2) = 0 then b := true; // цифра четная if b then writeln('Цифра ', a1, ' четная.') else writeln('Цифра ', a1, 'нечетная.'); end; readln; end. Задача №3 program krug; var n : integer; // кол-во точек oxc, oxy : real; // координаты круга r, d : real; // радиус, расстояние от центра до точки mx, my : real; // координаты точки i : integer; // счетчик i1: integer; // кол-во точек попавших в круг begin writeln('введите координаты круга.'); readln(oxc, oxy); writeln('введите радиус.'); readln(r); writeln('введите кол-во точек.'); readln(n); i1 := 0; for i := 1 to n do begin writeln('введите координаты ', i, ' точки.'); readln(mx, my); d := sqrt(sqr(oxc-mx)+sqr(oxy-my)); if d <= r then begin writeln('Точка с координатами ', mx:2:2, ' ', my:2:2, ' попала в круг.'); inc(i1); end else writeln('Точка с координатами ', mx:2:2, ' ', my:2:2, ' не попала в круг.'); end; writeln('в круг попало ', i1, ' точек.'); readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Кувалдин Алексей Юрьевич! Никогда не задавайте по нескольку вопрососов. Эксперту важно ответить хотя бы на 1. Остальные ответы Вы можете не получить. Решения остальных задач в приложении. Приложение: В первый год было выращено 0.5 кг шиповника. На каждый последующий год сбор урожая увеличивается на 4% от предыдущего урожая. Каким будет урожай шиповника на 4-й год? 8‑й год? 12-й год? uses crt; var u:real; i:integer; begin clrscr; u:=0.5; {начальный урожай} for i:=2 to 12 do {смотрим 12 лет} begin u:=u*1.04; {каждый год на 4% больше} if i mod 4=0 then {если год кратен 4} writeln('Na ',i,' god urozaj = ',u:0:3);{выводим данные} end; readln end. Задан список участников соревнования по плаванию и их результаты. Напечатать фамилию и результат чемпиона. (Даны два массива: для фамилий и для результатов.) uses crt; var f:array[1..50]of string;{список участников} r:array[1..50]of real; {список результатов} n,i,imin:byte; min:real; begin clrscr; repeat write('Kolicestvo uchastnykov n='); readln(n); until (n>0)and(n<=50); {проверяем правильность ввода} for i:=1 to n do begin write('Familia uchastnika ',i,': '); {вводим фамилии} readln(f[i]); write('Rezultat uchastnika ',i,': ');{вводим результаты в десятых и сотых секунды, 54,23; 52,18 - такая дистанция, типа 100 м кролем} readln(r[i]); end; min:=r[1];imin:=1; for i:=2 to n do if r[i]<min then begin min:=r[i]; {ищем минимальный результат, он и есть чемпион} imin:=i; {запоминаем его номер} end; writeln; writeln('Familia chempiona ',f[imin],' ego rezultat ',r[imin]:0:2); readln end. · Дана действительная матрица размером n*m. Найти сумму наименьших значений элементов строк. Отсортировать матрицу по возрастанию. Составить блок-схему алгоритма. program forum1; uses crt; var a:array[1..100,1..100]of real;[действительная матрица} v,min,sum:real; i,i2,i3,n,m:integer; begin clrscr; randomize; write('Vvedi N '); readln(n); write('Vvedi M '); readln(m); writeln('Ishodnaya matrica:'); for i:=1 to n do begin for i2:=1 to m do begin a[i,i2]:=10*random;{случайные вещественные значения в инт. 0-10 } write(a[i,i2]:5:2); end; writeln; end; writeln; sum:=0; for i:=1 to n do begin min:=a[i,i2]; for i2:=1 to m do if a[i,i2]<min then min:=a[i,i2];{находим минималбные в строках} sum:=sum+min; {суммируем их} end; writeln('Summa minimumov strok = ',sum:0:2); for i3:=1 to n*m do {сортировка матрицы по возрастанию} for i:=1 to n do for i2:=1 to m do begin if i2<>m then {если не конец строки} begin if a[i,i2+1]<a[i,i2] then {обычная сортировка обменом} begin v:=a[i,i2+1]; a[i,i2+1]:=a[i,i2]; a[i,i2]:=v; end; end else if (a[i+1,1]<a[i,i2])and(i<>n) then {если последний в строка и строка не последняя, сравнивается с первым в следующей строке} begin v:=a[i+1,1]; a[i+1,1]:=a[i,i2]; a[i,i2]:=v; end; end; writeln; writeln('Otsortirovannaya matrica:'); for i:=1 to n do begin for i2:=1 to m do write(a[i,i2]:5:2); writeln; end; readln; end. Напечатайте заданную последовательность символов, заменяя каждую точку многоточием. uses crt; var s:string; i,k:integer; begin clrscr; k:=0; repeat writeln('Vvedite posledovatelnost simvolov, soderzashuyu tochki:'); readln(s); for i:=1 to length(s)do {проверяем, есть ли во введенной последовательности точки} if s[i]='.'then begin k:=1; break; end; until k=1; for i:=length(s) downto 1 do {читаем строку с конца (обязательно!)} if s[i]='.' then insert('..',s,i);{находим точку, добавляем еще 2} write(s); readln end.

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

Вопрос № 153.276

Здравствуйте, уважаемые эксперты. Помогите решить задачу. Даны натуральные числа i, j, действительная матрица размера 18Х24 (1<=i<j<=24). Поменять в матрице местами I-й и j-й столбцы. Заранее спасибо.

Отправлен: 07.12.2008, 07:41 Вопрос задал: Морозов Артём Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Layer Здравствуйте, Морозов Артём Сергеевич! В приложении код процедуры, меняющей местами i и j столбцы в матрице A: array[1..18, 1..24]of extended Приложение: procedure ChangeCols(i,j: integer); var k: integer; tmp; extended; begin for k:=1 to 18 do begin tmp := A[k,i]; A[k,i] := A[k,j]; A[k,j] := tmp; end; end;

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Морозов Артём Сергеевич! Решение задачи с пояснениями в приложении. Очень болшое количество столбцов не позволяет разместить матрицу на экране в обычном порядке и лишает возможности проверить результат работы. У меньшил количество столбцов до 14, можете обратно вернуть как было. Кстати рычать на эксперта, который безвозмездно выложил Вам алгоритм решения задачи, не надо, дописать начало и конец программы должен уметь каждый двоешник. Намотайте себе это на ус, если хотите и впредь пользоваться услугами портала. Приложение: uses crt; {модуль для работы с экраном, звуком и клавиатурой, в частности здесь используется для очистки экрана от предыдущих записей} const n=18; {количество строк} m=14; {количество столбцов} var a:array[1..n,1..m]of real; {массив действительных чисел} x,y,i,j:integer;{х-счетчик цикла по строкам, у-счетчик чикла по столбцам, i,j-заданные столбцы} z:real; {переменная-буфер при обмене элементов} begin {начало программы} clrscr; {очищение экрана} randomize; {процедура, генерующая случайные чимла} writeln('Ishodnaja matrica:'); {выводим надпись} for x:=1 to n do {идем по строкам} begin for y:=1 to m do {идем в строке} begin a[x,y]:=9*random; {присваиваем элементам матрицы случайные значения из диапазона (0,9)} write(a[x,y]:4:1); {выводим значения в строку, выделяя под каждое число 4 позиции и оставляя 1 знак после запятой} end; writeln; {переходим на новую строку} end; readln;{делаем задержку до нажатия Enter, чтоб посмотреть на матрицу, больше мы ее не увидим } repeat {начало цикла ввода номера заданного столбца с прверкой соответствия условию} write('i='); readln(i); until (i>0)and(i<m); repeat {аналогично номер другого столбца} write('j='); readln(j); until (j>i)and(j<=m); for x:=1 to n do {переставляем элементы заданных столбцов} begin z:=a[x,i]; {запоминаем элемент в столбце i} a[x,i]:=a[x,j]; {на его место ставим соответствующий элемент из столбца j} a[x,j]:=z;{в столбец j ставим запомненный элемннт столбцаi} end; writeln('Rezultat:'); {в качестве самостоятельной работы прокомментировать оставшиеся строки, палец у меня отнялся, которым печатаю} for x:=1 to n do begin for y:=1 to m do write(a[x,y]:4:1); writeln; end; readln end.

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

Вопрос № 153.293

Здравствуйте уважаемые эксперты! Помогите пожалуйста решить задачу. Дана матрица А(n*n) целых чисел. Найти среднее арифметическое наибольшего и наименьшего значений ее элементов. Если полученный результат больше нуля, то поменять местами элементы главной и побочной диагоналей. Если результат меньше нуля, то изменить знаки элементов, расположенных выше главной диагонали на противоположные. Заранее спасибо!

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

Отвечает: Шичко Игорь Здравствуйте, Воробьев Максим Игоревич! Предлагаю Вам вариант решения. Поскольку в условии не сказано что делать при нуле, то если результат равен нулю, то массив остается без изменений. Удачи. Приложение: const n = 10; var a: array[1..n, 1..n] of integer; i, j, min, max, temp: integer; begin randomize; for i:= 1 to n do begin for j:= 1 to n do begin a[i,j]:= random(100) - 30; write(a[i,j]:5); end; writeln; end; min:= a[1,1]; max:= a[1,1]; for i:= 1 to n do {находим минимум и максимум} for j:= 1 to n do begin if a[i,j] > max then max:= a[i,j]; if a[i,j] < min then min:= a[i,j]; end; if (max + min) / 2 > 0 then {если больше 0} begin for i:= 1 to n do begin temp:= a[i, i]; a[i,i]:= a[i, n-i+1]; a[i, n-i+1]:= temp; end; end; if (max + min) / 2 < 0 then {если меньше 0} begin for i:= 1 to n do for j:= i+1 to n do a[i, j]:= (-1) * a[i, j]; end; writeln; writeln('min = ', min:6); writeln('max = ', max:6); writeln('(max + min) / 2 = ', (max + min) / 2 :6:2); writeln; for i:= 1 to n do begin for j:= 1 to n do write(a[i,j]:5); writeln; end; readln; end.

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

Вопрос № 153.294

Здравствуйте, уважаемые эксперты. Помогите пожалуйста с решением задачи в Паскале. Текстовый файл содрежит информацию об успеваемости студентов некоторого факультета за все время обучения (10 семестров - 10 оценок). Создать файл, где первой будет строка "Средняя успеваемость" и под ней оценки с первого файла. Удалить с получившегося второго текстового файла те строки, в которых средний балл меньше 3,5. Пояснение: Первый файл: Код: 4 5 4 3 5 4 5 4 3 5 5 4 5 5 5 4 4 5 4 5 3 4 3 3 3 4 3 3 4 3 3 4 3 5 4 5 5 4 3 5 Второй файл: Считать дынные из первого файла и скопировать это во второй файл, сверху написав "Средняя успеваемость", после этого найти средний балл в каждой стр оке второго файла и удалить те строки, в которых средний балл меньше 3,5. Если это нетрудно реализовать, напишите в кажой строчке второго фала перед оценками фамилию студента. То есть второй файл должен получиться примерно таким: Код: Средняя успеваемость Иванов 4 5 4 3 5 4 5 4 3 5 Сидоров 5 4 5 5 5 4 4 5 4 5 Нагуманов 3 4 3 3 3 4 3 3 4 3 Пригожин 3 4 3 5 4 5 5 4 3 5 После удаления тех строк, средний балл в котрых меньше 3,5, файл будет выглядить так: Код: Средняя успеваемость Ива нов 4 5 4 3 5 4 5 4 3 5 Сидоров 5 4 5 5 5 4 4 5 4 5 Пригожин 3 4 3 5 4 5 5 4 3 5 Если писать не будете, скажите, как превратить данные из файла в одинарный массив?

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

Отвечает: Шичко Игорь Здравствуйте, Багаутдинов Рафис Газинурович! Предлагаю Вам следующий алгоритм решения. Код в приложении. Раздел 1 - формирование файла с успеваемостью Раздел 2 - его преобразование На диске остаются два файла: 'c:inf.txt' - старый , 'c:inf1.txt' - новый Приложение: type Info = record name: string; ball: array[1..10] of integer; end; const n = 20; var f, f1: TextFile; st: array[1..n] of Info; i, j, summ, code: integer; av: real; temp: char; begin [b]{1}[/b] AssignFile(f, 'c:inf.txt'); Rewrite(f); write(f, 'Средняя успеваемость.'); writeln(f); for i:= 1 to 4 do {предусмотрено для 4, установите сами необходимое число (до 20)} begin writeln('Name ', i); readln(st[i].name); writeln(f, st[i].name); for j:= 1 to 10 do begin writeln('ball ', j); readln(st[i].ball[j]); write(f, st[i].ball[j]); end; writeln(f); end; Close(f); [b]{2}[/b] AssignFile(f, 'c:inf.txt'); Reset(f); i:=1; AssignFile(f1, 'c:inf1.txt'); Rewrite(f1); writeln(f1, 'Средняя успеваемость.'); readln(F); while NOT EOF(f) do begin readln(f, st[i].name); summ:= 0; for j:= 1 to 10 do begin read(f, temp); Val(temp, st[i].ball[j], code); summ:= summ + st[i].ball[j]; end; av:= summ / 10; {расчет ср. балла} if av > 3.5 then begin writeln(f1, st[i].name); for j:= 1 to 10 do write(f1, st[i].ball[j]); writeln(f1); end; readln(f); inc(i); end; close(f); close(f1); end.

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

Вопрос № 153.295

Общие указания при составлении программ к данной теме: 1. Текст стандартного типа String ввести с клавиатуры. 2. Между словами могут быть различные разделители (пробел, запятая, точка и т.д.), которые необходимо задать во множестве. 3. Вывести исходный текст и текст после преобразования его по условию задачи. Определить в тексте предложение с максимальным количеством слов. Вывести его на экран. В этом предложении удалить слово минимальной длины.

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

Отвечает: Verena Здравствуйте, Sema666! Текст не должен быть больше 255 символов, будем рассматривать предложение как набор слов и разделителей, заканчивающийся точкой. Для примера я взяла разделители пробел, запятая и двоеточие (Вы можете добавить свои в множество), точка в множество не входит, поскольку требует особого рассмотрения. Сначала просматриваем текст на предмет поиска предложения, в котором больше всего слов (если таких несколько, берётся первое). Если предложений вдруг вообще не оказалось, программа завершается. Далее предложение просматривается на предмет поиска минимального слова (если таких несколько, берётся первое). Можно было бы всё это при желании объединить, но вышло бы слишком запутано. Пример в приложении, из комментариев должно быть всё ясно. Удачи! Приложение: Var txt, p: string; i, kw, pb, pl, l, maxkw, maxpb, maxpl, minw, minl: integer; d: set of char; begin d:= [' ', ':', ',']; {Множество, задающее разделители внутри предложения} readln (txt); {Считываем текст} l:= length (txt); {Запоминаем длину} i:= 1; kw:= 0; pb:= 1; maxkw:=0; pl:= 0; {Счётчик, кол-во слов в текущем предложнении, начало текущего предложения, максимальное количество слов, длина текущего предложения} while (i<=l) do {Пока не конец строки} begin while (i<=l) and (txt[i] in d) do inc (i); {Пропускаем разделители} if (txt[i]='.') then {Если попалась точка} begin pl:= i-pb; {Считаем длину предложения} if (kw>maxkw) then {Если число слов больше максимального} begin {Переписываем максимальное и координаты предложения} maxpb:= pb; maxpl:= pl; maxkw:=kw; end; pb:= i+1; {Начало следующего предложения} inc (i); {Переходим через точку} kw:= 0; {Обнуляем число слов} end; if (i<=l) and not (txt[i] in d) then inc (kw); {Если дальше есть слово - наращиваем счётчик} while (i<=l) and not (txt[i] in d) and (txt[i]<>'.') do inc (i); {Пропускаем слово} end; if (pl=0) then halt(1); {Если нет предложений - прерываемся} p:= copy (txt, maxpb, maxpl); {Выписываем предложение} l:= length (p); {Запоминаем длину} writeln (p); {Выводим в первоначальном виде} minl:=l; {За минимальную принимаем длину предложения} i:=1; {Начиная с первого символа} while (i<=l) and (p[i] in d) do inc (i); {Ищем начало слова} minw:=i; {Принимаем первое слово за минимальное} while i<=l do {Пока не конец предложения} begin while (i<=l) and (p[i] in d) do inc (i); {Пропускаем разделители} kw:= i; {Запоминаем начало слова} while (i<=l) and not (p[i] in d) do inc (i); {Пропускаем слово} if (i-kw<minl) and (i-kw>0) then {Если слово было и оно короче минимального} begin {Запоминаем его параметры} minl:= i-kw; minw:= kw; end; end; {Удаляем минимальное слово} delete (p, minw, minl); writeln (p); {Выводим предложение} end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 153.321

Здравствуйте уважаемые эксперты.Помогите пожалуйста решить задачи. 1.Найти номер максимального элемента таблицы a[1..10]. 2. Дана действительная матрица размера m*n. Определить числа b1,...,bm равные суммам элементов ее строк.

Отправлен: 07.12.2008, 14:20 Вопрос задала: Анастасия Викторовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Анастасия Викторовна! Задачи с комментариями в приложении. Удачи!!! Приложение: {1} const {Длина массива} N = 10; var {сам массив} a: array [1..N] of integer; {i-для For, max-максимальное число, imax-номер} i, max, imax: integer; begin {Заполняем массив случайными числами и выводим его} write('A: '); randomize; for i := 1 to N do begin A[i] := random(14) - 7; Write(A[i]:3); end; {В начале максимальный элемент - первый} max := A[1]; imax := 1; {Перебираем остальные элементы массива} for i := 2 to N do {если элемент больше, то сохраняем его и его номер} if A[i] > max then begin max := A[i]; imax := i; end; WriteLn; {Ответ} WriteLn('Максимальный элемент под номерон ', imax); ReadLn; end. {2} const {Размеры матрицы} M = 5; N = 8; var {Матрица} matrix: array [1..M, 1..N] of real; {суммы элементов её строк} b: array [1..M] of real; {для For} i, j: integer; begin {Заполняем матрицу случайными числами и выводим её на экран} randomize; for i := 1 to M do begin for j := 1 to N do begin matrix[i, j] := random(6) - 3 + random; write(matrix[i, j]:6:2); end; WriteLn; end; {В цикле перебираем все строки матрицы} Write('Ответ: '); for i := 1 to M do begin {Вначеле сумма равнв нулю} b[i] := 0; {Перебираем все элементы строки и прибавляем их к сумме} for j := 1 to N do b[i] := b[i] + matrix[i, j]; {Выводим} Write(b[i]:6:2); end; ReadLn; end.

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

Вопрос № 153.328

1) составить программу, которая удаляет лишьние пробелы в строке. (задача по разделу "файлы", в ходе программы в файл file1.txt заносятся символы, после чего над ними выполняются операции, а результат заносится в файл file2.txt) заранее спасибо...

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Мирякубов Григорий Алексеевич! Решение задачи в приложении. Там где у меня написано 2 пробела, не надо писать 1, а то в Вашем тексьте не только лишние пробелы исчезнут, а вообще все. Приложение: uses crt; var f,g:text; {две переменных для связи с файлвми} s:string; {строка для обработки текста} i:integer; begin clrscr; assign(f,'file1.txt'); {связываем переменную f с файлом file1} rewrite(f); {открываем его для записи} write(f,'assdd gfghhh hjjjkjk bhhnhnjnjj!');{вводим в него текст} reset(f); {открываем для чтения} assign(g,'file2.txt'); { связываем переменную g с файлом file2} rewrite(g); {открываем для записи} while not eof(f) do {пока не конец файла f} begin readln(f,s); {считываем из него текст по строкам} while(pos('_ _',s))>0 do{пока рядом 2 пробела (_ вместо пробела)} delete(s,pos('_ _',s),1);{здесь в кавычках тоже 2 пробела, а удаляем 1} writeln(g,s); {записываем строку в новый файл} end; close(f); {закрываем файлы} close(g); write('Fail file2 zapisan!'); readln end.

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

Вопрос № 153.330

Уважаемые эксперты, помогите пожалуйста найти ошибку в программе. Работа с записями . Заполнить ячейки Марка, Фирма, Класс автомобиля и год выпуска. Вывести на экран только те строки, где фирма = Mersedes; и год выпуска=200; Данные заносятся и выводятся (если полностью) отлично. А с условием не получается. Приложение: uses crt; type Ttel=record mark:string[20]; firm:string[4]; class:string[20]; year:string[20]; end; var sp,sf,sfi:array[1..100]of Ttel; n,i,k,m,f:integer; z_f,z_y:string[20]; begin clrscr; k:=0; write('Введите кол-во автомобилей='); readln(n); writeln('-------------------------------------------', '-----------------------------------'); writeln('| Марка | Фирма производитель |', ' Класс автомобиля | Год издания |'); writeln('-------------------------------------------', '-----------------------------------'); for i:=1 to n do begin write('| | |', ' | |'); gotoxy(2,4+i); readln(sp[i].mark); gotoxy(3 + 20,4+i); readln(sp[i].firm); gotoxy(4+20+20,4+i); readln(sp[i].class); gotoxy(5+20+21+20,4+i); readln(sp[i].year); end; writeln('-------------------------------------------', '-----------------------------------'); z_f:='Mersedes'; z_y:='2000'; writeln('-------------------------------------------', '-----------------------------------'); writeln('| Марка | Фирма производитель |', ' Класс автомобиля | Год издания |'); writeln('-------------------------------------------', '-----------------------------------'); writeln; for i:=1 to n do for i:=1 to n do begin if (z_f=sp[i].firm) and (z_y=sp[i].year) then begin writeln('|',sp[i].mark:11,'|',sp[i].firm:26,'|', sp[i].class:24,'|',sp[i].year:13,'|'); inc(k); end; end; if k=0 then writeln('Не имеется полей удовлетворяющих заданным параметрам'); writeln('-------------------------------------------', '-----------------------------------'); readkey; end.

Отправлен: 07.12.2008, 15:32 Вопрос задал: Bulletproof (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: 6a3uJI Здравствуйте, Bulletproof! У Вас следующая ошибка: type Ttel=record mark:string[20]; firm:string[4]; class:string[20]; year:string[20]; end; При описании записи поле firm:string[4]. Вы же исчите z_f='Mersedes' - размер строки не соответствует выбранному полю. Увеличте размер поля до 20 символов. firm:string[20]. type Ttel=record mark:string[20]; firm:string[4]; class:string[20]; year:string[20]; end;

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

Вопрос № 153.334

Здравствуйте, уважаемые ЭКСПЕРТЫ))) Помогите, пожалуйста, решить задачи в Pascal: 1. Вычислить среднее арифметическое значение положительных элементов матрицы А(К,К), К<=60, лежащих над главной диагональю. 2. Найти значение выражения1*1+2*2+...+n*n. Не могли бы вы расписать всё как можно конкретнее, заранее спасибо)))))

Отправлен: 07.12.2008, 16:25 Вопрос задала: Martina (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Martina! 2. Необходимо найти сумму квадратов чисел от 1 до числа n. Для этого можно использовать цикл For. С помощью него проходим по числам и прибавляем их квадраты к сумме: Код: for i := 1 to n do sum := sum + i * i; Вот полный код: Код: var {n-число n, sum-сумма квадратов чисел от 1 до n, i-счетчик для цикла For} n, sum, i: integer; begin sum := 0; {Получаем n} Write('n: '); ReadLn(n); {В цикле проходим по числам от 1 до n} for i := 1 to n do {прибавляя к сумме квадрат каждого числа} sum := sum + i * i; Write('Ответ: ', sum); ReadLn; end. Удачи!!!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Martina! Решение первой задачи с пояснениями в приложении. Приложение: uses crt; const nmax=60; {максимальный размер матрицы} var a:array[1..nmax,1..nmax]of real; sr:real; k,i,j,n:integer; begin clrscr; randomize; {генерация случайных чисел} repeat write('Razmer matricy k='); readln(k); until (k>1)and(k<=nmax);{вводим размер матрицы с проверкой диапазона} writeln('Matrica A:'); n:=0;sr:=0; {в начале количество и сумма элементов по условию =0} for i:=1 to k do begin for j:=1 to k do begin a[i,j]:=20*random-9; {случайные числа в инт. (-9; 11)} if (j>i) and(a[i,j]>0) then {если выше главной диагонали и положительное} begin n:=n+1; {считаем} sr:=sr+a[i,j]; {суммируем} end; write(a[i,j]:6:2); end; writeln; end; write('Srednee=',sr/n:0:2); {выводим результат=сумма/количество} readln end.

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

Вопрос № 153.341

Здравствуйте. Помогите пожалуйста решить две задачи, ничего в них не понимаю. 1.Сделать маленькими все буквы в тех словах, которые содержат не более трех разных букв (например, "зараза", "папа", "окорок", но не слова “нога”, “арбуз”). 2.Заменить регистр букв в каждом слове, содержащем две и более одинаковые гласные буквы.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Юля Одинкина! В приложении код программы для решения первой задачи. При проверке количества разных букв в слове их регистр не учитывается (т.е. 'o' = 'O') Если его надо учитывать - замените строку: IF kol_raznih(LoCase(sl)) <= 3 then{Если в нём не больше 3 разных букв - } на: IF kol_raznih(s)) <= 3 then{Если в нём не больше 3 разных букв - } С уважением, Дмитрий. Приложение: program z153341_1; Function LoCase(s:string):string;{перевод строки в нижний регистр} var s1,s2:String; i:Integer; begin s1:='A..Z'+'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';{список букв в верхнем регистре} s2:='a..z'+'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';{список соответствующих им букв в нижнем регистре} For i := 1 to length(s) do IF pos(s[i],s1) > 0 then{Если i-тый символ - буква в верхнем регистре - } s[i]:=s2[pos(s[i],s1)];{переводим её в нижний(вставляем вместо неё ту же буквы в нижнем регистре)} LoCase:=s; end; Function kol_raznih(sl:String):byte; var bukvi:String; i:Integer; begin bukvi:=''; For i:= 1 to length(sl) do IF pos(sl[i],bukvi) = 0 then{Если i-тая буква в этом слове ещё не встречалась - } bukvi:=bukvi+sl[i];{запоминаем её} kol_raznih:=length(bukvi); end; var s,sl,res:String; begin Write('Enter string: '); ReadLn(s); While length(s)>0 do{перебираем строку} begin While s[1] = ' ' do begin res:=res+' '; delete(s,1,1); end; IF (length(s) > 0)and(pos(' ',s) = 0) then{если у нас осталось одно слово без пробела - дописываем его в конец} s:=s+' '; sl:=copy(s,1,pos(' ',s)-1);{берём первое слово из строки} delete(s,1,pos(' ',s)); IF kol_raznih(LoCase(sl)) <= 3 then{Если в нём не больше 3 разных букв - } res:=res+LoCase(sl)+' '{пишем его в ответ в нижнем регистре} else res:=res+sl+' '; end; WriteLn('otvet: ',res);{выводим ответ} ReadLn(); end.

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

Вопрос № 153.343

Уважаемые Эксперты! Помогите пожалуйста с задачей: По введённым с клавиатуры значениям x вычислить Y=f(x) 1/√sin(П/2+x), если 0<x<П/2; У= tg(П/x)-√x^2-2, если П/2≤x<2; √|x+e*x|/0.7*(x+0.23) в остальных случаях. после "У=" должна стоять фигурная скобка (знак системы) но почему то сюда ее мне не удалось перенести.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Александр С! Решение в приложении. Комментариев нет, голая математика. Приложение: uses crt; var x,y:real; begin clrscr; write('x=');readln(x); if (x>0)and(x<pi/2)then y:=1/sqrt(sin(pi/2+x)) else if (x>=pi/2)and(x<2) then y:=sin(pi/x)/cos(pi/x)-sqrt(x*x-2) else y:=sqrt(abs(x+exp(x)))/(0.7*(x+0.23)); write('Y=',y:0:5); readln end.

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

Вопрос № 153.347

Уважаемые Эксперты! Пожалуйста помогите с задачей: Вычислить Z: Z=f(sin(a),cos(a))*√|f(a^2,e^a)|, {arcsin(u+v), u+v>0; где f(u,v)= {arccos(u+v), u+v<0; {u^2+v^2, u+v=0. Вместо 3-х фигурных скобок должна стоять одна большая (знак системы).

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Александр С! Решение задачи с определенными оговорками в приложении. Особо комментировать нечего, сплошная математика. Единственно, поскольку из обратных тригонометрических функций в Паскале есть только arctg (arctan), то пришлось выразить через него arcsin и arccos. Ршения в приведенном интервале проверил в Экселе, совпадают. Приложение: uses crt; var a,f1,f2,Z:real; begin clrscr; repeat write('a=');readln(a); until (a<=0)and(a>-0.715); if sin(a)+cos(a)>0 then f1:=arctan((sin(a)+cos(a))/sqrt(1-sqr(sin(a)+cos(a)))) else if sin(a)+cos(a)<0 then f1:=arctan(sqrt(1-sqr(sin(a)+cos(a)))/(sin(a)+cos(a))) else if sin(a)+cos(a)=0 then f1:=sqr(sin(a))+sqr(cos(a)); if a*a+exp(a)>0 then f2:=arctan((a*a+exp(a))/sqrt(1-sqr(a*a+exp(a)))) else if a*a+exp(a)<0 then f2:=arctan(sqrt(1-sqr(a*a+exp(a)))/(a*a+exp(a))) else if a*a+exp(a)=0 then f2:=sqr(a*a)+sqr(exp(a)); Z:=f1*sqrt(abs(f2)); write('Z=',Z:0:5); readln end.

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

Вопрос № 153.350

Помогите пожалуйста с задачей: Составьте рекуррентную формулу, используя которую для заданных с клавиатуры значений p,n, и a, вычислите значение Y: Y=(((((a-p)*n-p)*n-p)*n-p)*n-p)*n-p).

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Александр С! Ваша программа в приложении. Изменяя параметр I Вы можете выбрать нужное количество вхождений в рекурсию. Удачи! Приложение: var a,n,p:real; i:integer; function F(i:integer):real; begin if i=0 then F:=a-p else F:=F(i-1)*n-p; end; begin write('Enter N:');readln(n); write('Enter A:');readln(a); write('Enter P:');readln(p); i:=5; writeln('Y:=',F(i)); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 153.353

Уважаемые эксперты и помогите пожалуйста с 4 ой задачей: Оператор GOTO использовать запрещается!!! Найти предел последовательности lim (n^3+5)/(2*n^3+n^2+1) c точность до ε n->∞

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

Отвечает: Шичко Игорь Здравствуйте, Александр С! Предлагаю вариант решения. Код и описание в приложении. Приложение: var e, temp, rez, d: real; i: integer; begin writeln('Vvedite e '); {ввод погрешности} readln(e); i:= 1; d:= (i*i*i +5)/(2*i*i*i + i*i+1); {установка исхордных хначений} temp:= d; rez:= d; while d >= e do {до тех пор пока разность больше установленной } begin inc(i); {прибавляем 1} rez:= (i*i*i +5)/(2*i*i*i + i*i+1); {вычисляем} d:= Abs(rez - temp); {разность с предыдущим} temp:= rez; {запоминание значения} end; writeln('Rezultat = ', rez:10:4); {результат} readln; end.

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

Вопрос № 153.359

Здравствуйте, уважаемые эксперты, пожалуйста, помогите решить задачу в Паскале: Дано слово. Найти сколько раз буква "а" встречается в этом слове. Будет ли это число простым. Пожалуйста, напишите всё как можно конкретнее...Заранее ОГРОМНОЕ спасибо))))

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

Отвечает: Шевченко Дмитрий Здравствуйте, Martina! В приложении код программы со всеми пояснениями. С уважением, Дмитрий Приложение: program z153359; Function prostoe(ch:byte):boolean;{определяем, простое ли данное число} var prosto:boolean; i:byte; begin prosto:=true;{считаем это число простым} IF (ch mod 2) = 0 then{Если число делится на 2 - оно составное (это чтобы не проверять чётные числа)} prosto:=false; i:=3;{начинаем проверку на делимость с трёх} While prosto and (i <= trunc(sqrt(ch))+1) do{ищем делитель числа отличный от единицы} {"i <= trunc(sqrt(ch))+1" - Если дошли до корня из числа - дальше проверять не имеет смысла} begin prosto := prosto and not ((ch mod i) = 0);{если число делится нацело на i - оно составное} i:=i+2;{+2 - потому что будем проверять делимость на следующее нечётное число} end; IF ch = 2 then{2 - единственное простое чётное число} prosto:=true; prostoe:=prosto; end; var s:String; kol,i:byte; begin Write('Vvedite slovo: '); ReadLn(s); kol:=0; For i:= 1 to length(s) do{перебираем слово по буквам} IF s[i] = 'a' then{ищем буквы "a"} kol:=kol+1;{считаем их} WriteLn('bukva "a" vstrechaetsya ',kol,' raz'); IF prostoe(kol) then{проверяем, простое ли число количество букв "a"} WriteLn('Eto chislo - prostoe') Else WriteLn('Eto chislo - sostavnoe'); ReadLn(); end.

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

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