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

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

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

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

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

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

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

Выпуск № 757
от 17.12.2008, 05:05

Вопрос № 153887: Здравствуйте эксперты! Дан вещественный массив из 4 строк и 5 столбцов. Столбец, содержащий максимальный элемент, поменять местами со вторым столбцом....

Вопрос № 153.887

Здравствуйте эксперты! Дан вещественный массив из 4 строк и 5 столбцов. Столбец, содержащий максимальный элемент, поменять местами со вторым столбцом.

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

Отвечает: Шичко Игорь Здравствуйте, Александр С! Предлагаю вариант решения. Код в приложении. Замена производится, если номер столбца, содержащего макс. элемент, отличен от 2. Приложение: const n = 4; m = 5; var i, j, ind: integer; max, temp: real; a: array[1..n, 1..m] of real; begin randomize; writeln('Massiv 1'); for i:= 1 to n do {формируем исходный массив} begin for j:= 1 to m do begin a[i, j]:= Random(200) / 10 - 10; write(a[i,j]:8:2); end; writeln; end; max:= a[1,1]; ind:= 1; {находим максимум и номер столбца} for i:= 1 to n do for j:=1 to m do begin if a[i,j] > max then begin max:= a[i,j]; ind:= j; end; end; if ind <>2 then {если номер не равен 2 то меняем столбцы местами} begin for i:= 1 to m do begin temp:= a[i, 2]; a[i,2]:= a[i, ind]; a[i,ind]:= temp; end; end; writeln('Max = ', max:8:2); {выводим макс. значение и новый массив} writeln('Massiv 2'); for i:= 1 to n do begin for j:= 1 to m do write(a[i,j]:8:2); writeln; end; readln; end.

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

Вопрос № 153.893

Приветствую Вас уважаемые Эксперты! Я хочу задать вам пару вопросов по матрицам.Я ещё новичок и совсем ничего не понимаю в этом деле.Надеюсь вы мне поможете разобраться... Вот мои вопросы: 1)В матрице A[1..N,1..M] определить минимальный элемент каждой строки. Вывести на экран строку матрицы с максимальным минимумом. (пожалуйста напишите объяснения к производимым действиям) 2)В двумерном массиве A[N*M] проанализировать последний элемент в строке. Если он больше предшествующего, то найти минимальное этой строки, иначе строку рассортировать по убыванию.(пожалуйста напишите объяснения к производимым действиям) Заранее вас благодарю! Надеюсь вы не оставите мой вопрос без внимания! Спасибо !

Отправлен: 11.12.2008, 10:36 Вопрос задал: Aliyev Orxan Faxri-oglu (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Aliyev Orxan Faxri-oglu! Решение первой и второй задач в приложении. Как мог, объяснил. Приложение: uses crt; {модуль для работы с клавиатурой экраном, в данном случае для его очистки} const n=6; {размеры матрицы} m=7; var a:array[1..n,1..m]of integer;{матрица} i,j,min,max,imax:integer; begin clrscr; randomize; {генерация случайных чисел} writeln('Matrica A:'); {создание матрицы и вывод ее на экран} 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:=-maxint-1; imax:=1;{активизируем максимальное значение(самое маленькое допустимое число) и номер строки с ним} for i:=1 to n do begin min:=a[i,1]; {активизируем минимум в каждой строке} for j:=1 to m do if a[i,j]<min then min:=a[i,j]; {если находим самое маленькое число в строке, оно минимум} writeln('Min v stroke ',i,' =',min);{выводим его на экран} if min>max then {если этот минимум больше очередного максимума} begin max:=min;{запоминаем его} imax:=i; {запоминаем номер строки} end; end; writeln('Stroka s max min=',imax);{выводим строку на экран} for i:=1 to m do write(a[imax,i],' '); readln end. №2. uses crt; const n=6; m=7; var a:array[1..n,1..m]of integer; i,j,min,k,x:integer; begin clrscr; randomize; writeln('Matrica A:'); 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; for i:=1 to n do if a[i,m]>a[i,m-1] then {если последний элемент строки больше предпоследнего} begin min:=a[i,1]; {активизируем минимум} for j:=1 to m do if a[i,j]<min then min:=a[i,j];{ищем его в строке} writeln('Min v stroke ',i,' =',min); {выводим на экран} end else {иначе, если последний не больше} for j:=1 to m-1 do {сортируем строку по убыванию (стандартная сортировка обменом)} for k:=j+1 to m do if a[i,j]<a[i,k] then {большие идут в начало, маленькие в конец} begin x:=a[i,j]; a[i,j]:=a[i,k]; a[i,k]:=x; end; writeln('Izmenennaja matrica:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 153.903

Уважаемые эксперты, помогите пожайлуста решить задачку! Составить программу, которая вставляет в список L новый элемент F за каждым входжением элемента E. Приложение: Задача на динамическую память. (Требуется расширить одномерный массив.) Помогите пожайлуста, вся надежда на Вас!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Olga_ab! Программа в приложении, создает односвязанный динамический список, выводит его на экран, производит нужную подстановку в списке , выводит результат работы и освобождает используемую память. Удачи! Приложение: type {определяем пользовательский тип} TList=^RList; RList=record Element:char; Next:TList; end; var a,b,c:TList; d:integer; e,f:char; begin {формируем список случайно} a:=nil; d:=20; while d>0 do begin new(b); b^.Element:=chr(random(23)+32); b^.Next:=a; a:=b; dec(d); end; {выводим список на экран} while b<>nil do begin write(b^.Element:2); b:=b^.Next; end; writeln; {вводим элемент Е} write('Enter Element E:'); readln(e); {вводи элемент Ф} write('Enter Element F:'); readln(f); {начинаем поиск элементов Е} b:=a; while b<>nil do begin if b^.Element=e then begin {создаем новый элемент} new(c); c^.Element:=f; {вставляем его в список} c^.Next:=b^.Next; b^.Next:=c; end; b:=b^.Next; end; {выводим результат работы} b:=a; while b<>nil do begin write(b^.Element:2); b:=b^.Next; end; {освобождаем используемую память} repeat b:=a; a:=a^.Next; dispose(b); until a=nil; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 153.914

Здравствуйте уважаемые Эксперты, помогите пожалуйста с решением одной задачки: Дана действительная матрица размера m*n. Определить числа B1,...,Bm равные значениям средних арифметических элементов ее строк. Заранее благодарю.

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

Отвечает: Layer Здравствуйте, Adriano112! Код программы в приложении. К сожалению проверить не могу - нет под рукой компилятора, но думаю должно работать, если опечаток нет. Приложение: uses Crt; const m = 20; //количество строк n = 10; //количество столбцов var A: array[1..m,1..n] of extended; //действительная матрица m*n B: array[1..m] of extended; //Матрица средних арифметических по строкам i, j: integer; //переменные циклов begin Randomize; //инициализируем генератор случайных чисел for i:=1 to m do begin for j:=1 to n do begin A[i,j] := Random*Random(100000); //заполняем матрицу действительными числами write(A[i,j]:7:2); //попутно выводим матрицу на экран end; WriteLn; //переводим каретку на следующую строку end; for i:=1 to m do begin B[i] := 0; for j:=1 to n do B[i] := B[i] + A[i,j]; //суммируем элементы строки B[i] := B[i]/n; //вычисляем их среднее арифметическое WriteLn(B[i]); //Выводим значение end; Readln; end.

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

Вопрос № 153.919

Даны целые числа a1, ... , a50. Получить сумму тех чисел данной последовательности, которые кратны 5

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор! Программа в приложениии. Удачи! Приложение: var a:array[1..50]of integer; i,s:integer; begin {сбрасываем генератор} randomize; s:=0; for i:=1 to 50 do begin {создоем число} a[i]:=random(50); {выводим на экран} write(a[i]:8); {суммируем если кратно} if (a[i]mod 5)=0 then s:=s + a[i]; end; writeln; {выводим результат} writeln('Summa:',s); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 153.922

Даны целые числа a1, a2, a3. Получить численную матрицу [bij]i,j=1, 2, 3. для которой bij = ai - 3aj

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение задачи в приложении. Приложение: uses crt; const n=3; var a:array[1..n]of integer; b:array[1..n,1..n] of integer; i,j:integer; begin clrscr; writeln('Massiv A:'); for i:=1 to n do read(a[i]); readln; writeln('Matrica B:'); for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=a[i]-3*a[j]; write(b[i,j]:4); end; writeln; end; readln end.

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

Вопрос № 153.924

Дано натуральное число n. Получить последовательность b1, ... , bn , где при i = 1, 2, ... , n значение bi = 2i/i!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение задачи в приложении. Приложение: uses crt; const n=10; var b:array[1..n]of real; i:integer; begin clrscr; b[1]:=2; for i:=2 to n do b[i]:=b[i-1]*2/i; for i:=1 to n do writeln(b[i]:10:6); readln end.

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

Вопрос № 153.926

Даны натуральное число n, целые числа a1, ... , a39. В последовательности a1, ... , a39 заменить каждый из членов остатком от деления его квадрата на n.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение задачи в приложении. Приложение: uses crt; const n=39; var a:array[1..n] of integer; i:integer; begin clrscr; randomize; writeln('Ishodnyj massiv:'); for i:=1 to n do begin a[i]:=random(10)+1; write(a[i],' '); end; writeln; writeln('Rezultat:'); for i:=1 to n do write(sqr(a[i]) mod n,' '); readln end.

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

Вопрос № 153.929

Даны натуральное число n, символы s1, ... , sn. Выяснить, bvt.ncz kb в последовательности s1, ... , sn такие члены последовательности si, si+1, что si - это запятая, si+1 - тире.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение задачи в приложении. Приложение: uses crt; const n=10; var s:array[1..n]of char;{массив символов, можно строку} i,k:integer; begin clrscr; write('Vvedite ',n,' simvolov:'); for i:=1 to n do read(s[i]); readln; k:=0; for i:=1 to n do if (s[i]=',')and(s[i+1]='-') then {если находим нужное сочетание} begin writeln('Takie chleny posledovatelnosti est!');{сообщаем} readln;{читаем} k:=1; {фиксируем} halt; {заканчиваем программу} end; if k=0 then writeln('Takih chlenov v posledovatelnosti net!'); readln {если нет, сообщаем} end.

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

Вопрос № 153.956

Здравствуйте уважаемые эксперты, помогите пожалуйста решить две задачки: 1) дано натуральное число n, действительные числа a1, ... , an. Вычислить a1 + ... + an 2) Дано действительные числа a1, ... , a37. Все элементы этой последовательности, точнее с первого положительного уменьшить на 0,5

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

Отвечает: Кулик Александр Сергеевич Здравствуйте, Иванов Виктор! решение второй задачи в приложении Приложение: var b:array[1..37] of real; i,n,k:integer; BEGIN for i:=1 to 37 do b[i]:=random(9)-5.0; for i:=1 to 37 do write(b[i]:4:1); writeln; writeln; for i:=1 to 37 do begin if b[i]>0 then begin for k:=i to 37 do b[k]:=b[k]-0.5; break; end; end; for i:=1 to 37 do write(b[i]:4:1); readln; END. --------- нет ничего невозможного!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! Программа в приложении по первой задаче. Удачи! Приложение: const n=10; var a:array[1..n]of real; b:real; c:integer; begin {создаем и выводим массив} for c:=1 to n do begin a[c]:=100*random; write(a[c]:8:3); end; {суммируем массив} b:=0; for c:=1 to n do b:=b+a[c]; {выводим результат} writeln('Summa:=',b:8:3); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 153.983

Приветствую уважаемые Эксперты, прошу вашей помощи с решением следующей задачки: Составить программу для нахождения наименьших элементов матриц А(10,12), В(15,10) и C(8,10) и номеров строк и столбцов, в которых они находятся, используя процедуру. Заранее спасибо. Вся надежда только на вас.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Adriano112! Решение с пояснениями в приложении. Приложение: uses crt; const nmax=20; type TMatr=array[1..nmax,1..nmax] of integer;{тип массива для передачи параметром в процедуру} procedure MinEl(x,y:integer; z:Tmatr; var mn,imn,jmn:integer); {процедура - входные параметры-размеры, сама матрица, выходные - минимум, его номера строки и столбца} var i,j:integer; begin mn:=z[1,1];imn:=1;jmn:=1; for i:=1 to x do for j:=1 to y do if z[i,j]<mn then begin mn:=z[i,j];{находим минимальный} imn:=i; {запоминаем строку} jmn:=j; {запоминаем столбец} end; end; procedure Matr(x,y:integer; var z:Tmatr);{процедура вывода матрицы, чтоб не писать три раза входные - размеры, выходной параматр - матрица} var i,j:integer; begin for i:=1 to x do begin for j:=1 to y do begin z[i,j]:=random(20); write(z[i,j]:4); end; writeln; end; writeln; end; var a,b,c:Tmatr; {раздел переменных} min,imin,jmin:integer; begin clrscr; randomize; writeln('Matrica A:'); {дальше создаем матрицу, ищем параметры по условию, выводим на экран} Matr(10,12,a); MinEl(10,12,a,min,imin,jmin); writeln('Minimalnyj element matricy A=',min,' v str ',imin,' v stb ',jmin); readln; writeln('Matrica B:'); Matr(15,10,b); MinEl(15,10,b,min,imin,jmin); writeln('Minimalnyj element matricy B=',min,' v str ',imin,' v stb ',jmin); readln; writeln('Matrica C:'); Matr(8,10,c); MinEl(8,10,c,min,imin,jmin); writeln('Minimalnyj element matricy C=',min,' v str ',imin,' v stb ',jmin); readln end.

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

Вопрос № 154.000

Здравствуйте! Уважаемые специалисты, прошу помощи по выполнению курсовика по информатике! Нужно выполнить задание в турбо паскале: Выполнить над прямоугольной матрицей В с размером m * n последовательность действий, указанную в задании: а) заменить заданным вектором столбцы матрицы В, не содержащие ни одного отрицательного элемента; б) в полученной матрице найти сумму элементов строк с четными номерами, содержащих хотя бы один нулевой элемент. заранее огромнейшее спасибо! P.S. 435469772 - аська

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

Отвечает: Кулик Александр Сергеевич Здравствуйте, Grausam! решение в приложении, решение без процедур и функции, поэтому текст немного запутанный, будут вопросы, стучи в асю Приложение: uses crt; var b:array[1..100,1..100] of integer; v:array[1..100] of integer; i,j,s,m,n,k:integer; BEGIN clrscr; {chast a} writeln('vvedite m i n'); readln(m,n); for i:=1 to m do for j:=1 to n do b[i,j]:=random(9)-random(9); for i:=1 to m do begin for j:=1 to n do write(b[i,j]:2); writeln; end; writeln('vvedite vektor iz ',m,' elementov'); for i:=1 to m do read(v[i]); k:=0; for j:=1 to n do begin for i:=1 to m do begin if b[i,j]>=0 then begin inc(k); if k=m then begin for i:=1 to m do b[i,j]:=v[i]; k:=0; end; end; if i=m then k:=0; end; end; writeln; for i:=1 to m do begin writeln; for j:=1 to n do write(b[i,j]:2); end; {chast b} writeln; s:=0; for i:=1 to m do for j:=1 to n do if (i mod 2 =0) then begin if b[i,j]=0 then begin for j:=1 to n do s:=s+b[i,j]; writeln('summa ',i,' stroki=',s); inc(i); s:=0; end; end; readln; END. --------- нет ничего невозможного!

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

Вопрос № 154.005

Вводишь коэф. и степень очередного монома,до тех пока не введешь 0 0 затем выводишь на экран (прим) 2 3 4 5 0 0 2x^3+4x^5 Причем выведенный полином должен быть с упорядоченными степенями и коэф. нужно сделать с помощью указателей и через процедуры зараннее спасибо)

Отправлен: 11.12.2008, 21:46 Вопрос задал: Andrew Shtamburg (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Miracle Здравствуйте, Andrew Shtamburg! program 154005 type TList=^rList; rList=record x,y:integer; z:TList;{указатель на следующий элемент} end; var a,b,c:TList; d,e:integer; begin a:=nil; repeat b:=a; {вводим коэфициэнт и степень} write('Ax:');readln(e); write('x^:');readln(d); if (e<>0)or(d<>0)then begin {начинаем поиск степени в списке} c:=nil; while (b<>nil)and(b^.y<>d) do b:=b^.z; if b<>nil then begin b^.x:=b^.x+e;{нашли суммируем} end else begin{ненашли} new(c);{создаем новый элемент} c^.x:=e;{запоминаем коэфициэнт} c^.y:=d;{запоминаем степень} end; if c<>nil then{если новый элемент создавался} begin if (c^.y>a^.y)or(a=nil) then{проверяем больше ли он первого элемента в списке} begin c^.z:=a; a:=c; end else begin{вставляем в список после всех элементов степень которых больше введенного} b:=a; while (b^.z^.y>c^.y)and(b^.z<>nil) do b:=b^.z; c^.z:=b^.z; b^.z:=c; end; end; end; until (e=0)and(d=0); writeln; b:=a; {вывод результата и освобождение занимаемой памяти} c:=a; while b<>nil do begin a:=b; if (c=nil)and(b^.x>0)then write('+'); if a^.x <> 0 then begin write(a^.x,'x^',a^.y); c:=nil; end; b:=b^.z; dispose(a); end; readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Andrew Shtamburg! Вариант работающий в АВС-паскале. Удачи! Приложение: type TList=^rList; rList=record x,y:integer; z:TList; end; var a:TList; {процедура ввода данных} procedure LoadList(var b:TList); var c:TList; d,e:integer; begin repeat {ввод } write('Ax:');readln(e); write('x^:');readln(d); if (d<>0)and(e<>0)then begin c:=b; {поиск степени} while (c<>nil)and(c^.y<>d) do c:=c^.z; if c<>nil then c^.x:=c^.x+e{дописываем существующею степень} else begin new(c);{новый элемент} c^.x:=e;{записываем коэфициент} c^.y:=d;{записываем степень} c^.z:=b;{формируем список} b:=c;{новый указатель на список} end; end; until (d=0)and(e=0); end; procedure ShowList(b:TList); var c:boolean; begin c:=false; while b<>nil do begin if c and (b^.x>0) then write('+');{выводим знак} if b^.x<>0 then{выводим коэфициэнт и степень} begin write(b^.x,'x^',b^.y);{вывод} c:=true;{флаг первого числа} end; b:=b^.z;{} end; end; procedure SortList(var b:TList); var c,d:Tlist; begin repeat repeat c:=b;{начинаем проверку с начала списка} d:=nil;{флаг замены} {проверяем упорядоченный ли список} while (c^.z<>nil)and(c^.y>c^.z^.y) do c:=c^.z; {если условие выполняется, то список не упорядочен и производим замену} if c^.z<>nil then begin d:=c^.z;{производится замена и сбрасывается флаг} c^.z:=d^.z; d^.z:=b; b:=d; end; until c^.z=nil; until d=nil; end; procedure KillList(b:TList); var c:TList; begin repeat c:=b; b:=b^.z; dispose(c); until b=nil; end; begin a:=nil; LoadList(a);{Ввод данных} SortList(a);{Сортируем список} ShowList(a);{Вывод данных} KillList(a);{освобождаем память} writeln; write('Stop'); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.016

Turbo Pascal 1 задача: С клавиатуры вводится натуральное число n. Найдите сумму первых элементов последовательности Фибоначчи до n-ного включительно. 2 задача: выод всех совершенных чисел, не превосходящих 10 000. 3 задача: с клавиатуры вводятся два натуральных числа a и b. Распечатайте все простые числа на отрезке [a, b]. 4 задача: для заданной пары натуральных чисел вычислите наибольший общий делитель 5 задача: распечатайте трехзначные числа в порядке возрастания суммы цифр 6 задача: вводится год и месяц. задача: вывести количество дней в указанном месяце. + год может быть високосным Извините, что так много. уже запутался, но не могу идти дальше не поняв, как решить и написать программы по этим задачам. Большое спасибо уважаемые эксперты :)

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

Отвечает: Шичко Игорь Здравствуйте, Зуев Игорь Владимирович! Примерные коды задач 1-3 в приложении. Приложение: {1} program fibonachi; var i, n, summ: integer; a: array[1..1000] of integer; begin writeln('Vvedite 2 < n < 1001'); readln(n); if (n < 3) or (n > 1000) then begin writeln('Error: Vvedite 2< n < 1001'); readln; exit; end; summ:=0; a[1]:= 1; a[2]:=1; summ:= summ + a[1] + a[2]; for i:= 3 to n do begin a[i]:= a[i-2] + a[i-1]; summ:= summ + a[i]; end; writeln('Summa ' , n , ' chisel Fibonachchi:'); writeln('Summa = ' , summ); readln; end. {2} program prostye_chisla; function Prost(num: integer):boolean; var temp: boolean; i: integer; begin temp:= True; for i:= 2 to num-1 do begin if num mod i = 0 then temp:= False; end; Prost:= temp; end; var a, b, i, kol: integer; begin writeln('Vvedite a'); readln(a); writeln('Vvedite b > a'); readln(b); if a >= b then begin writeln('Vvedite b > a'); readln; exit; end; kol:=0; for i:= a to b do begin if Prost(i) then begin kol:=kol+1; writeln('Cbislo #', kol:3, ': ', i:5); end; end; readln; end. {3} program soversh_chisla; function Sov(num: integer):boolean; var temp: boolean; i, summ: integer; begin temp:= False; summ:=0; for i:= 1 to num - 1 do if num mod i = 0 then summ:= summ + i; if num = summ then temp:= True; Sov:= temp; end; var a, i, kol: integer; begin writeln('Vvedite a'); readln(a); kol:=0; for i:= 1 to a do begin if Sov(i) then begin kol:=kol+1; writeln('Cbislo #', kol:3, ': ', i:5); end; end; readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Зуев Игорь Владимирович! Программа в приложении. Все задачи выполняются последовательно. Удачи! Приложение: uses crt; var k,m,n:integer; function Finobachi(x,y,z:integer):real; begin if z>0 then Finobachi:=Finobachi(x+y,x,z-1)+x else Finobachi:=z; end; function Nod(x,y:integer):integer; begin if (x mod y)>0 then Nod:=Nod(y,x mod y) else Nod:=y; end; function CheckSumm(x:integer):integer; begin if x>9 then CheckSumm:=(x mod 10) + CheckSumm(x div 10) else CheckSumm:=x; end; begin { I } writeln('Number I:'); repeat Write('Enter N:'); readln(n); until n>0; writeln('Summa:=',Finobachi(1,0,n):0:0); writeln('Press any key ...'); ReadKey; { II } writeln('Number II:'); n:=10000; repeat m:=n - 1;{} k:=0;{} while m>0 do begin k:=k + ord((n mod m)=0)*m; dec(m); end; if k=n then write(n:7); dec(n) until n=1; writeln; writeln('Press any key ...'); ReadKey; { III } writeln('Number III:'); repeat write('Enter A:'); readln(n); until n>0; repeat write('Enter B(b>',n,'):'); readln(m); until m>n; repeat k:=n-1; while (k>1)and((n mod k)>0)do dec(k); if k=1 then write(n:7); inc(n); until n>m; writeln; writeln('Press any key ...'); ReadKey; { IV } writeln('Number IV:'); repeat write('Enter C:'); readln(n); until n>0; repeat write('Enter D:'); readln(m); until m>0; writeln('NOD:=',Nod(n,m)); writeln('Press any key ...'); ReadKey; { V } writeln('Number V:'); n:=1; repeat write('Summa:',n); m:=100; repeat k:=CheckSumm(m); if k=n then write(m:5); inc(m); until m=1000; writeln; inc(n); until n>27; writeln('Press any key ...'); ReadKey; { IV } writeln('Number VI:'); repeat write('Enter Year:'); readln(n); until n>0; repeat write('Enter Month:'); readln(m); until (m>0)and(m<13); writeln('In month:',(30 + ord((m mod 2)>0) - (2-ord((n mod 4)=0))*ord( m = 2 )),' days'); writeln('Press any key ...'); ReadKey; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.024

Помогите пожалуйста...Я из сельской местности..С Паскалем туго было...Решение задачи:Даны натуральное число n ,действительные числа a1,...,an.Выяснить,является ли последовательность a1,...,an упорядоченной по убыванию.

Отправлен: 11.12.2008, 23:22 Вопрос задал: Чешков Роман Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Кулик Александр Сергеевич Здравствуйте, Чешков Роман Владимирович! Вот один из вариантов решения, последовательность считается упорядоченной по убыванию, если элементы повторяются друг за другом, пример: 4 3 2 2 1 - упорядочена решение в приложении Приложение: var a:array[1..100] of integer; i,n,k:integer; BEGIN writeln('vvedite n'); readln(n); writeln('vvedite posledovatelnost iz ',n,' elementov'); for i:=1 to n do read(a[i]); for i:=1 to n do if a[i]>=a[i+1] then inc(k); if k=n then writeln('uporyadochena') else writeln('ne uporyadochena'); END. --------- нет ничего невозможного!

Ответ отправил: Кулик Александр Сергеевич (статус: 3-й класс) Ответ отправлен: 11.12.2008, 23:46 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 238349 на номер 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