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

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

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

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

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

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

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

Выпуск № 741
от 30.11.2008, 07:35

Вопрос № 151635: Здравствуйте эксперты! Помогите решить задачу: Составить программу, проверяющую, является ли матрица А трехдиагональной. Матрицу А нужно вводить с клавиатуры....

Вопрос № 151.635

Здравствуйте эксперты! Помогите решить задачу: Составить программу, проверяющую, является ли матрица А трехдиагональной. Матрицу А нужно вводить с клавиатуры.

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

Отвечает: Verena Здравствуйте, Петров Иван Сергеевич! Матрица называется трехдиагональной, если все ее элементы, кроме элементов главной и примыкающих к ней диагоналей, равны нулю. Выглядит это примерно так: Координаты элементов главной диагонали определяются условием равенства номера столбца номеру ряда, т.е i=j. Соседние диагонали можно выразить условиями j=i-1 и j=i+1 для левой и правой диагоналей соответственно. Для того, чтобы проверить условие задачи, достаточно проверить равенство нулю всех элементов, этому условию не удовлетворяющих. Это можно выразить, например, таким условием: if (not ((i=j) or (j=i+1) or (j=i-1))) and (a[i, j]<>0) - этот элемент нарушает условие трёхдиагональности Честно скажу, я не знаю, обязательно ли должны быть ненулевыми элементы на самих диагоналях, поэтому это условие я не пр оверяю. Если необходимо - достаточно добавить проверку противоположного условия: if ((i=j) or (j=i+1) or (j=i-1)) and (a[i, j]=0) - этот элемент нарушает (возможно) условие трёхдиагональности Для упрощения кода в случае нахождения одного несоответствия программа завершается через halt - чтобы не использовать флаги. Код в приложении. Удачи! Приложение: uses crt; {модуль для работы процедур clrscr, readkey } Var a: array [1..10, 1..10] of integer; i, j, n: integer; begin writeln ('Vvedite n:'); {Ввод данных} readln (n); writeln ('Vvedite elementi:'); for i:=1 to n do for j:=1 to n do readln (a[i, j]); clrscr; {Очистка экрана} for i:=1 to n do {контрольный вывод} begin for j:=1 to n do write (a[i, j]:4); writeln; end; {проверка условий} for i:=1 to n do for j:=1 to n do {тут при необходимости можно добавить ещё проверку} if (not ((i=j) or (j=i+1) or (j=i-1))) and (a[i, j]<>0) then begin writeln ('Net'); {результат проверки} readkey; {ожидание клавиши} halt (1); {выход} end; writeln ('Da'); {результат проверки} readkey; {ожидание клавиши} end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 151.638

Здравствуйте эксперты! Объясните пожалуйста алгоритм программы. Приложение: const n=5; m=6; var a:array[1..n,1..m]of integer; p,k,i,j:integer; begin randomize; for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); write(a[i,j]:4); end; writeln; end; repeat write('Enter K:'); readln(k); until (k>0)and(k<=m); repeat write('Enter P:'); readln(p); until (p>0)and(p<=n); for i:=1 to n-1 do for j:=1 to m-1 do a[i,j]:=a[i+ord(p<=i),j+ord(k<=j)]; for i:=1 to n-1 do begin for j:=1 to m-1 do write(a[i,j]:4); writeln; end; readln; end.

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

Отвечает: Шичко Игорь Здравствуйте, Петров Иван Сергеевич! Примерно так: begin randomize; {Запуск генератора случайных чисел} for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); {заполение матрицы случайными числами от 1 до 10} write(a[i,j]:4); {вывод на экран} end; writeln; end; repeat write('Enter K:'); readln(k); { ввод номера столбца, который нужно удалить, должен быть в интервале от 1 до m} until (k>0)and(k<=m); repeat write('Enter P:'); readln(p); { ввод номера строки, которую нужно удалить, должна быть в интервале от 1 до n} until (p>0)and(p<=n); for i:=1 to n-1 do for j:=1 to m-1 do a[i,j]:=a[i+ord(p<=i),j+ord(k<=j)]; {вычисление новых элементов матрицы} {Функция ord(p<=i) возвращает 0 если условие в скобках не выполняется, т.е. при i<p} {Функция ord(p<=i) возвращает 1 если условие в скобках выполняется, т.е. при p<=i} for i:=1 to n-1 do begin for j:=1 to m-1 do write(a[i,j]:4); {вывод результата} writeln; end; readln; end.

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

Вопрос № 151.647

Здравствуйте, уважаемые Эксперты! Помогите, пожалуйста, в решении следующих задач: 1. Даны целые положительные числа M и N. Сформировать целочисленную матрицу размера M × N, у которой все элементы I-й строки имеют значение 10∙I (I = 1, …, M). 2. Даны целые положительные числа M, N, число D и набор из N чисел. Сформировать матрицу размера M ґ N, у которой первая строка совпадает с исходным набором чисел, а элементы каждой следующей строки равны соответствующему элементу предыдущей строки, умноженному на D (в результате каждый столбец матрицы будет содержать элементы геометрической прогрессии). 3. Дана матрица размера M × N и целое число K (1 < K < M). Вывести элементы K-й строки данной матрицы. 4. Дана матрица размера M × N. Вывести ее элементы, расположенные в столбцах с нечетными номерами (1, 3, …). Вывод элементов производить по столбцам, условный оператор не использовать. 5. Дана квадратная матрица A порядка M (M — нечетное число). Начин ая с элемента A[1,1] и перемещаясь против часовой стрелки, вывести все ее элементы по спирали: первый столбец, последняя строка, последний столбец в обратном порядке, первая строка в обратном порядке, оставшиеся элементы второго столбца и т. д.; последним выводится центральный элемент матрицы.

Отправлен: 24.11.2008, 14:55 Вопрос задала: Solnce1387 (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шевченко Дмитрий Здравствуйте, Solnce1387! В приложении код программ для заданий 1 и 3. С уважением, Дмитрий. Приложение: program z151647; const m = 10; n = 8; type elem = Integer;//тип элементов в массиве tmas = array[1..n] of elem; massive = array[1..m] of tmas;//массив массивов //Задача №1 procedure z1(var mas:massive); var i,k:Integer; begin For i := 1 to m do For k := 1 to n do mas[i][k] := 10 * i;//заполняем чтоб все элементы I-той строки имели значение 10*I end; //Задача №3 procedure fill(var mas:massive); var i,k:Integer; begin Randomize; For i := 1 to m do For k := 1 to n do mas[i][k]:=Random(100)+1;//заполняем числами от 1 до 100 end; procedure vivod_str(mas:tmas); var i:Integer; begin For i := 1 to n do Write(mas[i]:3,' ');//выводим строку массива WriteLn; end; //используется в задачах 1 и 3: procedure vivod(mas:massive); var i,k:Integer; begin For i := 1 to m do begin For k := 1 to n do Write(mas[i][k]:3,' ');//выводим массив WriteLn; end; end; var mas:massive; k:Integer; begin //задача №1 WriteLn('task 1:'); z1(mas);//заполняем массив как надо vivod(mas);//выводим массив //задача №3 WriteLn('task 3:'); fill(mas);//заполняем массив vivod(mas);//выводим массив Write('Enter k(1 < k < ',m,'): ');//ввод k ReadLn(k); WriteLn('stroka ',k,':'); vivod_str(mas[k]);{выводим k-тую строку матрицы. (mas[k]:tmas, т.е. array[1..n] of elem - это и есть одномерный массив, представляющий собой k-тую строку матрицы)} end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Solnce1387! Решение задач 2 и 4 в приложении. Приложение: №2. uses crt; const m=5; n=6; d=3; var a:array[1..m,1..n] of integer; b:array[1..n] of integer; i,j:integer; begin clrscr; randomize; writeln('Массив:'); for i:=1 to n do begin b[i]:=random(10)+1; write(b[i],' '); end; writeln; writeln('Матрица:'); for i:=1 to m do begin for j:=1 to n do begin if i=1 then a[i,j]:=b[j]*d {певая строка} else a[i,j]:=a[i-1,j]*d; {остальные строки} write(a[i,j]:5); end; writeln; end; readln end. №4. uses crt; const m=5; n=9; var a:array[1..m,1..n] of integer; i,j:integer; begin clrscr; randomize; writeln('Матрица:'); for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; writeln; writeln('Результат:'); for i:=1 to m do begin for j:=1 to (n div 2 + n mod 2) do {если точно до середины, если нечетные, до середины +1} write(a[i,j*2-1]:4); {нечетные номера в строках} writeln; end; readln end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Solnce1387! Задача №5 в приложении. Матрица "обходится" по спирали, элементы выводятся в одну строку. Удачи! Приложение: const m=7; var a:array[1..m,1..m]of integer; x,y,z:integer; begin {создаем матрицу и выводим} randomize; for x:=1 to m do begin for y:=1 to m do begin a[x,y]:=random(50); write(a[x,y]:4); end; writeln; end; writeln; {начинаем обход матрицы против часовой стрелки} z:=0; x:=1; y:=1; repeat repeat write(a[x,y]:4);{выводим текущий элемент} case z of{изменяем текущую координату} 0:inc(x); 1:inc(y); 2:dec(x); 3:dec(y); end; {повторяем пока не достигли диагонали} until(x=y)or((m-y+1)=x); {следующее напрвление} inc(z); {обошли круг переходим на меньший} x:=x+ (z div 4); y:=y+ (z div 4); {корректируем направление} z:=z mod 4; until (x=((m div 2)+1))and(y=((m div 2)+1));{повторяем пока не будем в центре} write(a[x,y]:4);{выводим центральный элемент} readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 151.650

Добрый день!Помогите пожалуйста решить задачи на массивы: 1.Задана последовательность X = (x1, x2, …, x10). Сформировать из неё одномерный массив Y, состоящий из элементов, удовлетворяющих условию: Xi>=P, где p - произведение элементов массива X, имеющих чётные индексы. Если таковых не окажется, вывести фразу «Искомых элементов нет». Полученный массив напечатать в столбик. X = {2.95, 7.34, -4.2, 0.5, -4.9, 0.22, 0.35, 1, 10.1, 12}. 2.На двумерный: Ai,j=1.473+j*i,если i+j>5 Ai,j=cos(j*i),в остальных случаях n=3,m=6 Элементы матрицы, имеющие отрицательные значения, сделать равными нулю, подсчитать и напечатать число этих элементов. Буду очень благодарна!

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

Отвечает: Шичко Игорь Здравствуйте, Evela! Предлагаю следующий вариант решения. Код в приложении. Приложение: const n = 3; m = 6; var x, y: array[1..10] of real; a: array[1..n, 1..m] of real; kol, i, j: integer; proizv: real; begin {1} for i:= 1 to 10 do begin writeln('Vvedite x', i); readln(x[i]); end; proizv:= 1; for i:=1 to 10 do if not Odd(i) then proizv:= proizv * x[i]; kol:= 0; for i:= 1 to 10 do if x[i] > proizv then begin kol:= kol + 1; y[kol]:= x[i]; end; if kol = 0 then writeln('Искомых элементов нет') else begin for i:= 1 to kol do writeln(y[i]:8:2); end; readln; {2} for i:=1 to n do for j:=1 to m do if i+j >5 then a[i,j]:= 1.473 + j * i else a[i, j]:= cos(i*j); kol:=0; for i:= 1 to n do begin for j:= 1 to m do begin write(a[i,j]:8:2); if a[i,j]<0 then begin kol:= kol+1; a[i,j]:= 0; end; end; writeln; end; writeln; for i:= 1 to n do begin for j:= 1 to m do write(a[i,j]:8:2); writeln; end; writeln('Kol = ', kol); readln; end.

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

Вопрос № 151.654

Здравствуйте люди добрые!!!! Нужен исходник шифрования методом Цезаря, только текст должен считываться из файла, и записываться в него. Шифрация и дешифрация!!!!!! Приложение: Спасибо !!!!!

Отправлен: 24.11.2008, 15:50 Вопрос задал: Harlamenkov Alexandr Nikolaevich (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Verena Здравствуйте, Harlamenkov Alexandr Nikolaevich! Данный шифр является одним из самых простых и легко алгоритмизируемых. © Цитата: Википедия Шифр Це́заря — один из древнейших шифров. При шифровании каждый символ заменяется другим, отстоящим от него в алфавите на фиксированное число позиций. Шифр Цезаря можно классифицировать как шифр подстановки, при более узкой классификации — шифр простой замены. Шифр назван в честь римского императора Гая Юлия Цезаря, использовавшего его для секретной переписки. Естественным развитием шифра Цезаря стал шифр Виженера. С точки зрения современного к риптоанализа, шифр Цезаря не имеет приемлемой стойкости. Я приведу Вам пример реализации, рассчитанный на использование алфавита из маленьких латинских букв (т.е. [abcdefghijklmnopqrstuvwxyz]). Алгоритм совершенно очевидный, берём символ, находим его номер в алфавите и заменяем на символ, следующий в алфавите через заданный шаг (шаг вводится при запуске). Алфавит рассматривается как замкнутый, т.е. из конча мы опять идём в начало, а из начала - в конец. Вообще, тут можно было бы воспользоваться остатком от деления, без заморочек с проверками, но при нумерации с 1 это не очень удобно, поэтому привожу примитивный вариант. Код в приложении. Удачи! Приложение: Const alph: string = 'abcdefghijklmnopqrstuvwxyz'; {Задаём алфавит} Var f, rez: text; {Файлы} s: string; l, ch: integer; procedure Encode (var s: string; l: integer); {Шифровать} Var i, k: integer; begin for i:=1 to length (s) do {Обрабатываем каждый символ} begin k:= pos (s[i], alph)+l; {Подсчитываем предполагаемый номер символа в алфавите для замены} if k>length(alph) then {Если число превысило размерность алфавита} s[i]:= alph [k-length(alph)] {Заменяем символ на тот, что будет стоять на соответствующей позиции в начале алфавита} else s[i]:= alph[k]; {Иначе просто заменяем на найденный} end; end; procedure Decode (var s: string; l: integer); {Расшифровать} Var i, k: integer; begin {Здесь всё аналогично} for i:=1 to length (s) do begin k:= pos (s[i], alph)-l; {Только номер определяется вычитанием} if k<1 then {И сравнение происходит с 1} s[i]:= alph [length(alph)+k] {Если он меньше 1, то берём соответствующий символ из конца} else s[i]:= alph[k]; end; end; begin writeln ('Vvedite chislo-sdvig: '); {Ввод данных} readln (l); writeln ('Vvedite imia faila: '); readln (s); writeln ('Shifrovat ili deshifrovat? 1/2'); readln (ch); assign (f, s); {Ассоциируем переменные с файлами на диске} assign (rez, 'd:ez.txt'); reset (f); {Открываем файлы} rewrite (rez); while not eof (f) do {Обработка} begin readln (f, s); if (ch=1) then Encode (s, l) else Decode (s, l); writeln (rez, s); end; {Закрываем файлы} close (f); close (rez); end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 151.666

Уважаемые эксперты пожадуста помогите решить задачу!!! Задача: как поменять местами наибольший и наименьший элементы в одномерном массива ??? Пожалуста.....

Отправлен: 24.11.2008, 17:25 Вопрос задала: Гриценко Тория Юрьевна (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Максимцов Дмитрий Здравствуйте, Гриценко Тория Юрьевна! Необходимо объявить новую переменную... Ей присвоить значение минимума, потом минимуму присвоить значение максимума, и в заключение максимуму присвоить значение вот той новой переменной :)... Надеюсь вам помогуло, если что можно подробней, но нужно только программу видеть ;)...

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

Отвечает: Яровой Сергей Владимирович Здравствуйте, Гриценко Тория Юрьевна! Вот примерный вариант решения задачи. Размерность массива свою подставите var mas: [1..10] array of integer; {задаем массив типа integer из 10 элементов} i, maxi, mini:byte; max,min:integer; begin for i:=1 to 10 do {начинаем забивать массив элементами} begin write ('Введите ',i,' элемент массива); readln(a[i]); end; min:=a[1]; {Обнуляем показатели min и max} max:=a[1]; for i:=1 to 10 do { В этом цикле находим максимальный и минимальный элементы массива и запоминаем их порядковый номер } begin if a[i]<min then begin min:=a[i]; mini:=i; end; if a[i]>max then max:=a[i]; maxi:=i; end; end; a[mini]:=max; { Переставляем местами максимальный и минимальный элементы} a[maxi]:=min; for i:=1 to 10 do write(a[i]:3); {Выводим массив на экран} end.

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

Отвечает: Miracle Здравствуйте, Гриценко Тория Юрьевна! В приложении программа. Она работает. Если будет что-то непонятно - пишите, я поясню. Приложение: program change; const N = 4; {количество элементов массива} var temp1, temp2, i: integer; {вспомогательные переменные} min, max: integer; a: array [1..N] of integer; begin {заполнение массива} for i:= 1 to N do begin writeln('a[i]'); readln(a[i]); end; min:= a[1]; max:= a[1]; temp1:= 1; temp2:= 1; {поиск максимального и минимального элементов} for i:=2 to N do begin if min>a[i] then begin min:= a[i]; temp1:=i; end else if max<a[i] then begin max:= a[i]; temp2:= i; end; end; {обмен местами min и max} i:= a[temp1]; a[temp1]:=a[temp2]; a[temp2]:=i; {вывод результата на экран} for i:= 1 to N do begin write (a[i], ' '); end; readln; end.

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

Вопрос № 151.680

Доброго времени суток,уважаемые эксперты!Помогите пожалуйста с задачей: Задана последовательность X = (x1, x2, …, x10). Сформировать из неё одномерный массив Y, состоящий из элементов, удовлетворяющих условию: Xi<=p, где p - сумма элементов массива X, имеющих нечётные индексы. Если таковых не окажется, вывести фразу «Искомых элементов нет». Полученный массив напечатать в строчку. X = {0.34, 99.2, 52.3, 0.5, 1, 2.23, -15.9, 10.2, 0, -3.9}. Заранее спасибо!

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

Отвечает: Шичко Игорь Здравствуйте, Evela! Предлагаю похожий вариант решения. Код в приложении Приложение: var x, y: array[1..10] of real; kol, i: integer; summ: real; begin for i:= 1 to 10 do begin writeln('Vvedite x', i); readln(x[i]); end; summ:= 0; for i:=1 to 10 do if Odd(i) then summ:= summ + x[i]; kol:= 0; for i:= 1 to 10 do if x[i] <= summ then begin kol:= kol + 1; y[kol]:= x[i]; end; if kol = 0 then writeln('Искомых элементов нет') else begin for i:= 1 to kol do write(y[i]:8:2); end; readln; end.

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

Вопрос № 151.682

Известна информация о сотрудниках некоторого предприятия: -фамилия,инициалы, -должность, -оклад. Сформируйте таблицу,записав в неё всю известную информацию о каждом сотруднике. Сформировать поле "Подоходный налог", учитывая, что он составляет 13% от оклада, и поле "К выплате".Определить количество сотрудников с минимальной зарплатой и количество с максимальной. Отсортировать таблицу по полю "должность".

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Денис! Решение и оформление задачи с комментариями в приложении. Приложение: uses crt; type Tsotr=record {объявляем тип запись с полями по условию} fio:string[20]; dlz:string[20]; okl:longint; pnl:integer; vpl:longint; end; var sp:array[1..50] of Tsotr; {массив записей, список сотрудников} x:Tsotr; {} n,i,j,k1,k2:integer; max,min:longint; begin clrscr; write('Введите количество сотрудников:'); readln(n); writeln('Введите данные о сотрулниках:'); min:=maxlongint;max:=0; {заполняем список, ищем макс и мин з/п} for i:=1 to n do begin writeln('Сотрудник ',i); write('Фамилия И.О. ');readln(sp[i].fio); write('Должность ');readln(sp[i].dlz); write('Оклад ');readln(sp[i].okl); sp[i].pnl:=round(sp[i].okl*0.13) ; {считаем налог и заносим в список} sp[i].vpl:=sp[i].okl-sp[i].pnl; { к выплате} if sp[i].vpl>max then max:=sp[i].vpl; {макс з/п} if sp[i].vpl<min then min:=sp[i].vpl; {мин з/п} end; for i:=1 to n-1 do for j:=1 to n-1 do if sp[j].dlz>sp[j+1].dlz then {сортируем массив по алфавиту должностей} begin x:=sp[j]; sp[j]:=sp[j+1]; sp[j+1]:=x; end; k1:=0;k2:=0; for i:=1 to n do begin if sp[i].vpl=max then k1:=k1+1; {считаем с макс з/п} if sp[i].vpl=min then k2:=k2+1; {считаем с мин з/п} end; clrscr; writeln('Максимальную зарплату имеют ',k1); writeln('Минимальную зарплату имеют ',k2); writeln; writeln(' Данные о заработной плате сотрудников:'); {выводим таблицу с данными о сотрудниках} writeln; writeln('----------------------------------------------------------------------'); writeln('| Фамилия И.О. | Должность | Оклад | НДФЛ | К выплате |'); writeln('----------------------------------------------------------------------'); for i:=1 to n do writeln('|',sp[i].fio:18,'|',sp[i].dlz:18,'|',sp[i].okl:9,'|',sp[i].pnl:8,'|',sp[i].vpl:11,'|'); writeln('----------------------------------------------------------------------'); readln end.

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

Вопрос № 151.721

Уважаемые эксперты!!! Помогите плз с такой задачей: составить программу для построения графика функции на указанном промежутке: X^2*sin^2(3*x) на промежутке от 0 до 1.6. Помогите пожалуйста!!!

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

Отвечает: Verena Здравствуйте, Мудрик Василий Александрович! Предлагаю довольно универсальный вариант решения - в программе можно задать другую функцию и другой диапазон. Нарисовать график произвольной функции можно просто по точкам, что довольно легко делается с помощью функции PutPixel (x, y, цвет), которая закрашивает пиксель с заданным координатами заданным цветом. Проблема возникает только в масштабировании графика относительно экрана. В моём примере область, отведённая под график, может задаваться в коде, а масштабирование происходит тривиально: коэффициент масштабирования, на который домножается координата точки, вычисляется как ширина (длина) поля, делённая на длину необходимого отрезка (например, для масштабирования отрезка [x1, x2] по оси Х с шириной поля w мы выберем масштаб w/|x1-x2|, а в моём примере для более красивого вывода я беру масштаб вдвое меньший). Для этих же целей нам необходимо выбрать точку начала координат (по х мы определим её как середину задаваемой области, а по y - как точку по чентру между локальных минимума и максимума функции на данном отрезке), относительно неё мы будем производить вывод точек графика. Остальное, думаю, будет ясно из комментариев. Пример в приложении. PS: Это слегка видоизменённый мой пример из вопроса 128922, описание взято оттуда же. Приложение: program groffunc; uses Graph; var x1,x2:real; {границы изменения аргумента функции } y1,y2:real; { границы изменения значения функции} x:real; { аргумент функции} y:real; { значение функции в точке х} dx:real; { приращение аргумента} l,b:integer; {левый нижний угол области вывода графика } w,h:integer; { ширина и высота области вывода графика} mx,my:real; { масшаб по осям X и Y} x0,y0:integer; { начало координат } st:string; grDriver: Integer; grMode: Integer; ErrCode: Integer; { Функция, график которой надо попстроить } Function f(x:real):real; begin {X^2*sin^2(3*x)} f:=sqr(x)*sqr(sin(3*x)); end; begin grDriver := VGA; {Инициализация графического режима} grMode:=VGAHi; InitGraph(grDriver, grMode,'c: p7'); {В последнем параметре надо указать путь к драйверу видеорежима на Вашем компьютере (это файл egavga.bgi, обычно лежит в папке с паскалем)} ErrCode := GraphResult; if ErrCode <> grOk then Halt(1); {При неудачной инициализации - завершаем программу} {Начальные данные задаются здесь} l:=40; b:=400; h:=200; w:=400; x1:=0; {Задаём диапазон} x2:=1.6; dx:=0.01; {Найдём максимальное и минимальное значение функции в диапазоне [x1,x2] } y1:=f(x1); { минимум} y2:=f(x1); { максимум} x:=x1; repeat y:=f(x); {Производим сравнение в цикле по смещению, заданному dx} if y<y1 then y1:=y; if y>y2 then y2:=y; x:=x+dx; until (x>=x2); my:=h/abs(y2-y1); {Определяем коэффициент масштабирования по X и по Y} mx:=w/(2*abs(x2-x1)); { Рисуем оси} x0:=l+w div 2; {Определяем точку начала координат (по середине осей} y0:=b-Abs(Round(y1*my)); Line(x0,b,x0,b-h); {Рисуем сами оси} Line(x0-w div 2,y0,x0+w div 2,y0); Str(y2:5:1,st); {Подписываем числа на оси Y} OutTextXY(x0+5,b-h,st); Str(y1:5:1,st); OutTextXY(x0+5,b,st); { Построение графика} x:=x1; str (x:1:1, st); {Подпишем числа на оси Х} OutTextXY (x0+Round (x*mx), y0+1, st); repeat y:=f(x); {Ищем значение функции} PutPixel(x0+Round(x*mx),y0-Round(y*my),15); {Рисуем точку (пиксель) в полученной координате, смастабированной относительно нашей плоскости (последний параметр - цвет)} x:=x+dx; {Смещаемся по Х} until (x>=x2); str ((x-dx):1:1, st); {Подпишем другой конец оси} OutTextXY (x0+Round ((x-dx)*mx), y0+1, st); Readln; CloseGraph; {Выходим из графического режима} end. --------- Эта история - не для истории, понимаешь?

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

© 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