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

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

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

Полтев Станислав Михайлович Статус: Практикант Рейтинг: 253 ∙ повысить рейтинг >>

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

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

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

Выпуск № 733
от 21.11.2008, 21:35

Вопрос № 150672: Здраствуйте,уважаемые эксперты. Помогите мне справится вот с такой задачей. Массив m получается из массива n следущим образом: Сначала идут четные цифры второй половины массива n , затем в обратном порядке цифры первой половины, затем нече...

Вопрос № 150.672

Здраствуйте,уважаемые эксперты. Помогите мне справится вот с такой задачей. Массив m получается из массива n следущим образом: Сначала идут четные цифры второй половины массива n , затем в обратном порядке цифры первой половины, затем нечетный цифры второй половины.(прим.ИСПОЛЬЗОВАТЬ ТОЛЬКО ОДИН МАССИВ)

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

Отвечает: Denisss Здравствуйте, Locust! Пример с комментариями находится в приложении. При нечетном n за первую половину принимается меньшая часть, за вторую - большая. Алгоритм такой: 1. Переводим цифры первой половины в обратный порядок (reverse). 2. Перебираем вторую половину (moveOddToStart). 2.1. Если найден четный элемент, сдвигаем массив (элементы первой половины и нечетные элементы второй) вправо, четный элемент перемещаем в бывшее начало первой половины (ShiftR). В примере используется всего один массив (arr). Тип PInt используется как указатель на этот массив (@arr). Удачи! Приложение: program Q150672; type { Указатель } PInt = ^Integer; { Вывод массива } procedure printArr(arr: PInt; const len: Byte); var i: Byte; begin if (len > 1) then for i:= 0 to (len - 2) do begin write(arr^, ', '); Inc(arr); end; writeln(arr^); end; { Обратный порядок } procedure reverse(arr: PInt; const fromPos, len: Byte); { Параметры: массив, начальная позиция, длина } var rarr: PInt; i: Byte; begin if (len < 2) then Exit; rarr:= arr; Inc(rarr, Pred(len)); for i:= 1 to (len div 2) do begin { Обмен значениями элементов } if (arr^ <> rarr^) then begin arr^:= arr^ xor rarr^; rarr^:= arr^ xor rarr^; arr^:= arr^ xor rarr^; end; Inc(arr); Dec(rarr); end; end; { Перемещение четных элементов второй половины в начало } procedure moveOddToStart(arr: PInt; const len: Byte); { Сдвиг массива вправо } procedure ShiftR(toPos: Pint); var harr: PInt; tmp: Integer; i: Byte; begin tmp:= toPos^; harr:= toPos; Dec(harr); while(harr <> arr) do begin toPos^:= harr^; Dec(toPos); Dec(harr); end; toPos^:= harr^; arr^:= tmp; end; var sarr: PInt; i: Byte; begin if (len < 2) then Exit; sarr:= arr; Inc(sarr, (len div 2)); { Поиск нечетных элементов } for i:= 1 to (Succ(len) div 2) do begin if ((sarr^ and 1) = 0) then begin ShiftR(sarr); Inc(arr); end; Inc(sarr); end; end; const { Максимальная длина массива } MAX_ARR_SIZE = 50; var arr: array[0..MAX_ARR_SIZE-1] of Integer; i, n: Byte; begin { Вводим n } repeat write('n = '); readln(n); until ((n <= MAX_ARR_SIZE) and (n > 0)); { Заполнение массива случайными числами } Randomize; for i:= 0 to Pred(n) do arr[i]:= Random(1000); printArr(@arr, n); { Первую половину переводим в обратный порядок } reverse(@arr, 0, n div 2); { Перемещаем четные элементы второй половины в начало } moveOddToStart(@arr, n); { Выводим результат } printArr(@arr, n); end. --------- Все должно быть сделано настолько просто, насколько это возможно. Но не проще. (с) А.Эйнштейн

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

Вопрос № 150.675

Драсте, помогите пожалуйста составить программу, проверяющую, является ли матрица A верхней треугольной с нулевой диагональю.з аранее спасибо

Отправлен: 16.11.2008, 10:08 Вопрос задал: Фёдоров Михаил Юрьевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Фёдоров Михаил Юрьевич! Программа выведет TRUE, если условие задачи удовлетворено, и FALSE в противном случае. Код: const n = 5; {размерность матрицы} var ms: array [1..n, 1..n] of byte; {матрица} i,j: integer; {переменные-индексы} rez: boolean; {вспомогательная переменная} begin randomize; {запускаем генератор случайных чисел} for i:=1 to n do {заполняем матрицу} begin for j:=1 to n do begin ms[i,j] := random(2); {генерируем число из диапазона [0; 2)} write(ms[i,j]:3); {выводим элемент на экран} end; writeln; {переход на следующую строку на экране} end; {writeln; writeln; } rez := true; j := 0; While rez and (j < n) do {до тех пор, пока переменная rez имеет значение ИСТИНА} begin {а также индекс не вышел за пределы размера матрицы} inc(j); {увеличиваем переменную j на единичку} for i:=1 to j do {проверяем строку ниже диагонали матрицы} begin {write(ms[i,j]:3); } {вывод символов для проверки} rez := rez and (ms[i,j] = 0); end; {writeln; } end; writeln(rez); readln; end. --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Вопрос № 150.676

Здраствуйте, составьте программу пожалуйста:для заданной матрицы A из p-й строки вычесть k-ю, умноженную на Apk/Akk. Матрицу вводить вручную. Заранее спасибо

Отправлен: 16.11.2008, 10:13 Вопрос задал: Фёдоров Михаил Юрьевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Фёдоров Михаил Юрьевич! Программа в приложении. После поэлементного ввода исходная матрица выводится в табличном виде - это сделано для более удобного просмотра как исходной, так и изменённой матрицы. При вводе коэффициентов p, k производится проверка на допустимость значений (так, чтобы они не выходили за границы матрицы и элемент A[k, k] не был равен нулю). Получилось немного длинно, но вроде бы всё просто. Желаю удачи! Приложение: Program Pr150676; Uses CRT; Const M = 5; N = 6; Var A: Array[1..M, 1..N] of Real; i, j, k, p: Integer; Koeff: Real; { = A[p,k] / A[k,k] } Begin ClrScr; WriteLn('Введите поэлементно матрицу A[', M, '*', N, ']:'); for i := 1 to M do begin WriteLn('Строка #', i, ':'); for j := 1 to N do begin Write(' A[', i, ',', j, '] = '); ReadLn(A[i, j]); end; end; ClrScr; WriteLn('Исходная матрица:'); WriteLn; for i := 1 to M do begin for j := 1 to N do Write(A[i, j]:10:4); WriteLn; WriteLn; end; WriteLn; Repeat Write('p = '); ReadLn(p); Write('k = '); ReadLn(k); if (p < 1) or (p > M) then WriteLn('Неверное значение для p!'); if (k < 1) or (k > N) then WriteLn('Неверное значение для k!'); if A[k, k] = 0 then WriteLn('A[', k, ',', k, '] = 0 !'); Until (p >= 1) and (p <= M) and (k >= 1) and (k <= N) and (A[k, k] <> 0); Koeff := A[p, k] / A[k, k]; for i := 1 to N do A[p, i] := A[p, i] - A[k, i] * Koeff; WriteLn('Обработанная матрица:'); WriteLn; for i := 1 to M do begin for j := 1 to N do Write(A[i, j]:10:4); WriteLn; WriteLn; end; WriteLn; Repeat Until KeyPressed; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

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

Вопрос № 150.686

Здравствуйте уважаемые эксперты! Помогите написать программу в Паскале: Дана матрица А(4х4) найти 1) сумму S отрицательных элементов на побочной диагонали; 2) найти наибольший элемент 2-го столбца и его местоположение; 3) заменить найденный максимальный элемент во 2-ом столбце на значение суммы S. Помогите плиз завтра уже здавать надо))) Ввод вывод сделал, сумму вроде находит, а вот максимум найти и его положение, никак, и заменить немогу. Заранее благодарен.

Отправлен: 16.11.2008, 11:48 Вопрос задал: Мединский Е. В. (статус: 1-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Шичко Игорь Здравствуйте, Мединский Е. В.! Примерный вариант решения задачи по разделам прилагаю в приложении. Приложение: var a: array[1..4, 1..4] of integer; i, j, max, row_max, summ: integer; begin {формирование массива} for i:=1 to 4 do begin for j:= 1 to 4 do begin if Odd(i+j) then a[i,j]:= (-1) * Random(10) else a[i,j]:= Random(10); write(a[i,j]:5); end; writeln; end; {1} summ:= 0; for i:=1 to 4 do for j:=1 to 4 do if ((i + j) = 5) and (a[i,j] < 0) then summ:= summ + a[i,j]; {2} max:= a[1, 2]; row_max:= 1; for i:= 2 to 4 do if a[i, 2] > max then begin max:= a[i,2]; {значение максимума} row_max:= i; {индекс строки} end; {3} a[row_max, 2]:= summ; {замена} {вывод результатов} writeln('Summ = ', summ:5); writeln; writeln('max = ', max:5); writeln; for i:=1 to 4 do begin for j:= 1 to 4 do write(a[i,j]:5); writeln; end; readln; end.

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

Вопрос № 150.711

Пожалуйста, помогите с решением задач на паскале!!! 1) Напечатать таблицу значений функции SIN(X) и COS(X) на задан- ном интервале [A,B] с заданным шагом D (считать, что при печати на каждое вещественное число отводиться 8 позиций, а под дроб- ную часть 6 позиций. 2) Задана последовательность из N вещественных чисел. Вычислить корень квадратный из ((XI-M)*(XI-M)/(N-1)), где M - среднее алгебраическое данной последовательности. 3) Переставляя строки и столбцы матрицы, добиться, что бы в левом верхнем углу оказался наибольший элемент матрицы (один из них). Заранее благодарен)))

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Lilcrazy! Решение первой и третьей задач в приложении. По второй: совершенно забыл формулу среднего алгебраического и найти не могу. Если подскажете, напишу и вторую. Приложение: Задача 1. uses crt; var a,b,x,dx,f,sum:real; n,i:integer; begin clrscr; write('Vvedite nachalo intervala a=');readln(a); repeat write('Vvedite konec intervala b=');readln(b); until b>a; {проверям, чтобы b было больше} write('Vvedite shag vychislenij dx='); readln(dx); x:=a-dx; {отступим назад, чтобы пройти весь интервал} while x<b do begin x:=x+dx; {вместо 8 позиций под sin, cos сделал 9, иначе не входит знак минус} writeln('x=',x:8:6, ' sinx=',sin(x):9:6,' cosx=',cos(x):9:6); end; readln end. Задача 3. uses crt; const n=5; m=6; var a:array[1..n,1..m]of integer; i,j,x,max,imax,jmax:integer; begin clrscr; randomize; writeln('Ishodnaya matrica:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; max:=a[1,1]; imax:=1; jmax:=1; {ищем максимальный элемент, номер строки и столбца, в которых он находится} for i:=1 to n do for j:=1 to m do if a[i,j]>max then begin max:=a[i,j]; {максимум} imax:=i; {номер строки} jmax:=j; {номер столбца} end; writeln('Max=',max,' imax=',imax,' jmax=',jmax); {перестановка строк} for j:=1 to m do begin x:=a[1,j]; a[1,j]:=a[imax,j]; {меняем местами элементы строки 1 со строкой, где макс} a[imax,j]:=x; end; {перестановка столбцов} for i:=1 to n do begin x:=a[i,1]; a[i,1]:=a[i,jmax];{меняем местами элементы столбца 1 со столбцом, где макс} a[i,jmax]:=x; end; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 150.719

Уважаемые эксперты помогите пожалуйста!!!!! Вот 2 задачи: 1) Дана сведения о резултатах сессии: ФИО студента, названя четырёх предметов и оценки, полученные по каждому предмету. Требуется вывести фамилии студентов, общий балл которых отличается не более чем на 2 балла о максимального общего балла. 2) Построить график функции: Y=-6x2+3x. (там икс в квадрате)! (В модуле GRAPH.TPU) Заранее огромное спасибо!

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

Отвечает: Петухов Артём Михайлович Здравствуйте, Борисов Виктор Евгеньевич! отвечаю только на первый вопрос. Обратите внимание что программа выводит фамилии студентов, общий бал которых отличается не более чем на 0.25 ! балла. Такая вот строгая программа. Приложение: program p_150719; uses crt; type st_20 = string[10]; predmet = record nazvanie : st_20; ocenka : integer; end; arr_p = array[1..4]of predmet; uchenik = record sername : st_20; pr : arr_p; sr :real; end; tabel = array [1..5] of uchenik; familii = array [1..5] of st_20; pr_naz = array [1..4] of st_20; var f:familii; p:pr_naz; t:tabel; i,j,summ:integer; tmp_p:arr_p; max:real; begin clrscr; randomize; textmode(co80+font8x8); max:=0; f[1]:='Иванов'; f[2]:='Петров'; f[3]:='Сидоров'; f[4]:='Смирнов'; f[5]:='Тяпкин'; p[1]:='Физика'; p[2]:='Алгебра'; p[3]:='Английский'; p[4]:='Русский'; for i:=1to 5do begin t[i].sername:=f[i]; summ:=0; for j:=1to 4do begin tmp_p[j].nazvanie:=p[j]; tmp_p[j].ocenka:=2+random(4); summ:=summ+tmp_p[j].ocenka; end; t[i].pr:=tmp_p; t[i].sr:=summ/4; if t[i].sr>=max then max:=t[i].sr; end; for i:=1to 5do begin write(t[i].sername:10); tmp_p:=t[i].pr; for j:=1to 4 do begin write(tmp_p[j].nazvanie:11,' ',tmp_p[j].ocenka); end; write('Средний':8,' ',t[i].sr:4:2); writeln; end; writeln('=========ЛУЧШИЕ=========='); for i:=1to 5 do begin if t[i].sr>=max-0.25 then begin write(t[i].sername:10); tmp_p:=t[i].pr; for j:=1to 4 do begin write(tmp_p[j].nazvanie:11,' ',tmp_p[j].ocenka); end; write('Средний':8,' ',t[i].sr:4:2); writeln; end; end; readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Борисов Виктор Евгеньевич! Вторая задача в приложении. Вопросы по задаче задавайте в мини-форум. Удачи! Приложение: uses crt,graph; const x1=-0.2;{начальная координата} x2= 0.7;{конечная координата} var x0,y0,i:integer; yMin,yMax,zx,zy:real; {выводимая функция} function F(x:real):real; begin F:=3*x-6*x*x; end; begin {инициализируем графический режим} x0:=detect; InitGraph(x0,y0,''); {если ошибки не было выводим график} if GraphResult=0 then begin {получаем размер экрана} x0:=GetMaxX;{горозонталь} y0:=GetMaxY;{вертикаль} zx:=abs(x1-x2)/(x0+5);{считаем горизонтальный коэфициэнт маштабирования графика графика} {ищем максимальное и минимальное значение функции} yMin:=F(x1); yMax:=F(x1); for i:=0 to x0 do begin if yMax<F(x1+i*zx) then yMax:=F(x1+i*zx); if yMin>F(x1+i*zx) then yMin:=F(x1+i*zx); end; {считаем вертикальный коэфициент маштабирования графика} zy:=abs(yMin-yMax)/(y0+5); {выводим оси координат} SetColor(3); Line(0,y0-round(-yMin/zy)+10,x0,y0-round(-yMin/zy)+10); Line(round(abs(x1/zx)),10,round(abs(x1/zx)),y0); {выводим график} for i:=0 to x0 do PutPixel(i,y0-round((F(x1+i*zx)-yMin)/zy)+10,14); readKey; CloseGraph; end else begin{сообщение об ошибке} write('Error init graph:',GraphResult); ReadKey; end; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 150.738

Решить уравнения f(x)=x*x*x-cos(x) методом простой итерации. заранее спасибо

Отправлен: 16.11.2008, 20:24 Вопрос задал: Игорь Вадимович (статус: 1-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Игорь Вадимович! Сначала уравнение f(x)=0 приводят к виду удобному для итерации x=ff(x). В вашем случае x:=exp(ln(cos(x))/3); Далее берут начальное приближение, подставляют в формулу, получают новый x и сравнивают с предыдущим. Если разница > eps то полученный x принимают за новое приближение и расчет повторяют. Решение в приложении. Приложение: uses crt; var x,x0,e:real; begin clrscr; x:=0.5; e:=0.001; repeat x0:=x; x:=exp(ln(cos(x))/3); until abs(x0-x)<=e; write('x=',x:0:3); readln end.

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

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