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

Выпуск № 650
от 06.06.2008, 03:05

Вопрос № 137.971

Здравствуйте, уважаемые эксперты! Я начал изучил процедуры и функции, поэтому эту задачу нужно разбить на максимальное количесво процедур и функций (три процедуры обязательны: ReadDate, Move, Print). Я прошу, чтобы вы подкинули мне идею написания программы. Ну что-то ничего в голову не идёт! По круку записаны n (n < 100) чисел - одна единица и остальные нули. Каждую секунду вместо числа x(k) (в круглых скобках я пишу индекс) пишут |2x(k)-x(k-1)-x(k+1)|. Определите, какие числа будут через n секунд. Выведите все промежуточные результаты, как указано ниже: 15 0: 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1: 2 1 0 0 0 0 0 0 0 0 0 0 0 0 1 2: 2 0 1 0 0 0 0 0 0 0 0 0 0 1 0 3: 4 3 2 1 0 0 0 0 0 0 0 0 1 2 3 4: 2 0 0 0 1 0 0 0 0 0 0 1 0 0 0 5: 4 2 0 1 2 1 0 0 0 0 1 2 1 0 2 6: 4 0 3 0 2 0 1 0 0 1 0 2 0 3 0 7: 8 7 6 5 4 3 2 1 1 2 3 4 5 6 7 8: 2 0 0 0 0 0 0 1 1 0 0 0 0 0 0 9: 4 2 0 0 0 0 1 1 1 1 0 0 0 0 2 10: 4 0 2 0 0 1 1 0 0 1 1 0 0 2 0 11: 8 6 4 2 1 1 1 1 1 1 1 1 2 4 6 12: 4 0 0 1 1 0 0 0 0 0 0 1 1 0 0 13: 8 4 1 1 1 1 0 0 0 0 0 1 1 1 4 14: 8 1 3 0 0 1 1 0 0 1 1 0 0 3 1 15: 14 9 5 3 1 1 1 1 1 1 1 1 3 5 9 Вся соль в том, что числа записаны по кругу. Заранее благодарен!

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

Отвечает: Delph Здравствуйте, Хощенко Артём Владимирович! Задача лекго решилась при помощи вспомогательного массива. Обратите внимание: вспомогательный массив Tmp обладает чуть более широкими границами, чем основной, иначе пришлось бы очень аккуратно проверять индексы и при выходе за границы массива перекидывать их на противоположный конец. Граничные значения Tmp берутся с противоположных концов основного массива Arr, что позволяет легче реализовать "закольцованность" данных. Основная же задача Tmp - хранение неизменного "снимка" данных с прошлого шага, когда на текущем шаге данные уже меняются. Приложение: Program Pr137971; Uses CRT; Var Arr: Array[1..100] of Integer; Tmp: Array[0..101] of Integer; n, i: Integer; Procedure ReadData(var n: Integer); var i: Integer; begin ClrScr; Write('n = '); ReadLn(n); for i := 2 to n do Arr[i] := 0; Arr[1] := 1; end; Procedure MoveData(n: Integer); var i: Integer; begin for i:= 1 to n do Tmp[i] := Arr[i]; Tmp[0] := Arr[n]; Tmp[n+1] := Arr[1]; for i := 1 to n do Arr[i] := Abs(2 * Tmp[i] - Tmp[i-1] - Tmp[i+1]); end; procedure PrintData(k, n: Integer); var i: integer; begin Write(k:2, ': '); for i := 1 to n do Write(Arr[i]:3, ' '); WriteLn; end; Begin ReadData(n); PrintData(0, n); for i := 1 to n do begin MoveData(n); PrintData(i, n); end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 27.05.2008, 09:59 Оценка за ответ: 5 Комментарий оценки: спасибо!

Вопрос № 138.006

Уважаемые эксперты,помогите пожалуйста решить задачу:Дан непомерный массив числовых значений,насчитываюший N элементов.Поменять местами М первых элементов с группой элементов,начинающихся с номера К.Большое спасибо:)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Igor lukashov! Решение задачи с небольшими пояснениями в приложении. Приложение: uses crt; var a:array[1..100]of integer; n,m,k,i,x:integer; begin clrscr; write('Vvedite razmer massiva n=');readln(n); repeat {ввод М, пока не бедет правильное} write('Vvedite chislo M<=n div 2 m='); readln(m); until m<n div 2; repeat {ввод К, пока не бедет правильное} write('Vvedite chislo K>M and K<=n-M k='); readln(k); until (K>M) and(K<=n-M); writeln('Ishodnyj massiv:'); For i:=1 to n do begin a[i]:=i; {для наглядности выведем числа подряд} write(a[i],' '); end; writeln; For i:=1 to m do begin x:=a[i]; {обмениваем элементы местами} a[i]:=a[k]; a[k]:=x; k:=k+1; end; writeln('Rezultat:'); for i:=1 to n do write(a[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 27.05.2008, 12:53 Оценка за ответ: 5 Комментарий оценки: Все решено просто на 5 с плюсом)

Вопрос № 138.018

Написать программу выдачи на экран монитора таблицы значений функций sin x и cos x на отрезке [0,1] с шагом 0,1 в следующем виде: X sin(x) cos(x) - - - - - - - - - - - - - - - - - - 0.0 0 0 0 0.0 0 0 0 1.0 0 0 0 0.1 0 0 0 0.0 9 9 8 0.9 9 5 0 Под каждое выводимое значение рекомендуется отводить 6 позиций.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хорост Андрей Викторович! Программа в прилoжении. Синус и косинус выводятся с форматом 8:4, иначе результаты сливаются. Удачи! Приложение: var x:real; begin x:=0; repeat{цикл вывода} writeln(x:6:4,cos(x):8:4,sin(x):8:4); x:=x+0.1; until x>1.1;{конец цикла} end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.021

Добрый день,помогите,пожалуйста решить следующую задачу..Заранее огромное спасибо.. Даны целое n>0 и последовательность из n вещественных чисел, среди которых есть хотя бы одно отрицательное число. Написать программу нахождения величины наибольшего среди отрицательных чисел этой последовательности.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Хорост Андрей Викторович! Задача с пояснениями в приложении. Удачи!!! Приложение: var {N-длина последовательности, i-счетчик для For} n, i: integer; {ivar-введенное число, max-максимальное отрицательное число} iVar, Max: real; begin {повторяем пока не введено N>0} repeat Write('Введите N (N>0): '); readln(n); until (N>0); {Нач. значение максимального числа, если не будет ни одного отр. то max=0 и программа выведе сообщении об отсутствии отр. чисел} max:=0; {Первый цикл ввода чисел завершится когда будет введено отр. число или когда введены все числа} for i:=1 to N do begin write('Введите число: '); readln(iVar); {если введено отр. число, то изменяем Max на это число и выходим из цикла} if iVar < 0 then begin Max:=iVar; break; end; end; {Второй цикл ввода} for i:=i+1 to N do begin write('Введите число: '); readln(ivar); {если введено отриц. и больше Max, то изменяем значение Max} if (iVar<0) and (iVar>max) then max:=iVar; end; {Введены ли отриц. числа?} if max <> 0 then {Да-выводим максимальное из них} write(max:8:3) else {Нет-сообщаем об ошибке} write('Нет отрицательных чисел!!!'); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 27.05.2008, 14:35 Оценка за ответ: 5

Вопрос № 138.022

Добрый день.Помогите,пожалуйста,решить следующую задачу..Заранее очень благодарен. Дана непустая последовательность натуральных чисел, за которой следует 0. Написать программу определения порядкового номера наименьшего из них.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хорост Андрей Викторович! Программа в приложении. Материал из Википедии : Существуют два подхода к определению натуральных чисел — числа, используемые при : перечислении (нумеровании) предметов (первый, второй, третий…) — подход, общепринятый в большинстве стран мира (в том числе и в России). обозначении количества предметов (нет предметов, один предмет, два предмета…). В программа работает по первому варианту. Удачи! Приложение: var w,x,y,z:word; begin z:=0; repeat{в цикле вводим числа} write('Enter number:'); readln(x); inc(z); {проверяем услововие} if ((z=1)or(x<y))and(x>0) then begin y:=x; w:=z; end; until x=0; writeln(y:7,w:8); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.023

Добрый день..Помогите,пожалуйста,решить задачу..Заранее огромная вам благодарность.. Дано 100 вещественных чисел. Написать программу вычисления разности между максимальным и минимальным из них.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Хорост Андрей Викторович! Задача в приложении. Все числа хранятся в массиве а. Размер массива хранится в константе N. Сначало с помощью цикла For перебирается весь массив и заполняется случайными числами с помощью функции random. Потом инициализируем максимальное и минимальное число значением первого элемента массива. Потом опят с помощью For перебираем весь массив и во время каждого прохода сравниваем текущий элемент с максимальным и минимальным, если максимальное меньше текущего, то изменяем значение максимального числа. В конце вычисляем и выводим разность. Удачи!!! Приложение: const N=100; var a: array [1..N] of real; i: integer; max, min: real; begin randomize; for i:=1 to N do begin a[i]:=random(100)-50+random; write(a[i]:8:3); end; max:=a[1]; min:=a[1]; for i:=1 to N do if a[i]>max then max:=a[i] else if a[i] < min then min:=a[i]; WriteLn; Write('max-min=', max-min:8:3); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 27.05.2008, 14:15 Оценка за ответ: 5

Отвечает: Delph Здравствуйте, Хорост Андрей Викторович! Вот вариант решения, где используется только один цикл. Здесь запоминаются не сами значения (максимальное и минимальное), а их индексы. Это даёт возможность сразу (до заполнения массива) дать стартовые значения индексам и проверять новые элементы уже по ходу их внесения. Приложение: Program Pr138023; Uses CRT; Const N = 100; Var Arr: Array[1..N] of Real; i, Min, Max: Integer; Begin ClrScr; Randomize; { Min и Max - индексы минимального и максимального элементов массива } Min := 1; Max := 1; WriteLn('Исходный случайно заполненный массив:'); for i := 1 to N do begin { Вносим в массив числа от 0 до 100 } Arr[i] := 100 * Random; Write(Arr[i]:9:4); if Arr[i] < Arr[Min] then Min := i; if Arr[i] > Arr[Max] then Max := i; { После каждого 8-го числа переходим на новую строку } if i mod 8 = 0 then WriteLn; end; WriteLn; WriteLn; WriteLn('Разница между минимальным и максимальным'); WriteLn('элементами равна ', (Arr[Max] - Arr[Min]):9:3); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 27.05.2008, 17:13 Оценка за ответ: 5

Вопрос № 138.026

Добрый день.Помогите,пожалуйста,с решением задачи.Заранее большое спасибо Вам. Дан массив отрицательных и положительных чисел с именем Х. Написать программу переноса отрицательных чисел в начало массива, а положительных в конец, сохраняя исходное взаимное расположение, как среди положительных чисел, так и среди отрицательных. При написании текста программ рекомендуется воспользоваться массивом У, как вспомогательным.

Отправлен: 27.05.2008, 10:44 Вопрос задал: Хорост Андрей Викторович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: SHERRY Здравствуйте, Хорост Андрей Викторович! Решение Вашей задачи в приложении. Выполняется по следующей схеме: В цикле считываем значения массива X и тут же смотрим: если элемент массива X меньше нуля (отрицательный), то добавляем его в начало массива Y. Потом пробегаем цикл ещё раз для выявления положительных чисел. Их записываем после отрицательных в массив Y. Нули становятся в конец массива Y. Затем значение массива Y присваиваем массиву X. Вот и всё. Удачи! Приложение: const n = 5; {количество элементов массива} var x,y: array [1..n] of integer; {собственно массивы} i,j: integer; {вспомогательные переменные} begin j:=1; for i:=1 to n do {в цикле} begin readln(x[i]); {считываем значение массива X} if x[i]<0 then {если оно отрицательное, то} begin y[j]:=x[i]; {записываем его в массив Y под номером j} inc(j); {j увеличиваем на единичку} end; end; for i:=1 to n do if x[i]>0 then {выявление положительных чисел} begin y[j]:=x[i]; {записываем значение элемента массива X в массив Y под номером j} inc(j); {увеличиваем j на единичку} end; x:=y; {значения массива Y присваиваем массиву X} end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 27.05.2008, 19:56 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хорост Андрей Викторович! Вариант без использования дополнительного массива. В начало массива смещаются только отрицательные, остальные (положительные и ноль) смещаются в конец массива. Удачи! Приложение: uses crt; const n=15; type Ta=array[1..n]of integer; var a:Ta; b,c:integer; procedure change(var a:Ta;b,c:integer); var d:integer; begin while (a[c-1]>=0)and(c>b)do begin {перестановка элементов массива} d:=a[c]; a[c]:=a[c-1]; a[c-1]:=d; dec(c); end; for b:=1 to n do begin {только для подсветки отрицательных чисел} if a[b]<0 then textcolor(15); {вывод} write(a[b]:4); textcolor(7); end; writeln; end; begin {массив формируется случайно} randomize; for b:=1 to n do begin a[b]:=random(50)-25; {подсвечиваем отрицательные элементы} if a[b]<0 then textcolor(15); {выводим элемент} write(a[b]:4); textcolor(7); end; writeln; {сортировка массива} for b:=1 to n-1 do for c:=b+1 to n do if (a[b]>=0) and (a[c]<0)then change(a,b,c); ReadKey; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.075

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

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Пухов Никита Евгеньевич! Программа в приложении. Если есть хоть один отрицательный элемент в строке - функция возвращает ноль. Удачи! Приложение: const n=5; m=10; type Ta=array[1..n]of integer; var a:array[1..m]of Ta; b,c:integer; function check(d:Ta):integer; var e,f:integer; begin e:=0; {контролируем одну строку} for f:=1 to n do if d[f]>=0 then e:=e+d[f]{суммируем} else begin{сбрасываем сумму и выходим} e:=0; break; end; check:=e; end; begin {создаем массив с помощью генератора случайных чисел} randomize; for b:=1 to m do begin for c:=1 to n do begin{создаем и выводим строку} a[b,c]:=random(20)-5; write(a[b,c]:4); end; {выводим результат работы функции} writeln(':=':4,Check(a[b]):7); end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Шемет Станислав Васильевич Здравствуйте, Пухов Никита Евгеньевич! Программа в приложении... Удачи.. Приложение: Const n=10; m=8; Var M:array[1..n,1..m] of integer; I,J:integer; Procedure Summa(x:integer); var sum:integer; Y:integer; Begin Sum:=0; For Y:=1 to m do sum:=sum+m[x,y]; Writeln('Сумма строки № ',x,' =',sum); end; Begin For i:=to n do For j:=1 to m do Begin Write('Елемент ',i,'x',j,' '); Readln(m[i,j]); end; For i:=1 to n do For j:=1 to m do If m[i,j]>=0 then If j=m then summa; Readln; end; --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 7-ой класс) Ответ отправлен: 27.05.2008, 17:14 Оценка за ответ: 5

Вопрос № 138.076

С клавиатуры вводиться одномерный массив А, размерностью n. Найти максимальный элемент данного массива. Ввод и вывод элементов оформить в виде процедуры.

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

Отвечает: Костя Симанович Здравствуйте, Пухов Никита Евгеньевич! Решение задачи в приложении. n кол-во эл-ов массива, можете задать любое на Ваш выбор, у меня 10. В первой процедуре (wwod) заполняем массив. Во второй процедуре (maxwiwiod) ищем максимальный эл-т и выводим его. Программа работает только с целыми числами. Надеюсь помог. Удачи. Приложение: program mass; const n = 10; {кол-во элементов массива} var a : array [1..n] of integer; max : integer; procedure wwod; var i : integer; begin for i := 1 to n do begin writeln('Введите ', i, ' элемент.'); readln(a[i]); end; end; procedure maxwiwod; {ищем максимальный и выводим результат} var i : integer; begin max := a[1]; {присваиваем первый эл-т масива} for i:= 2 to n do if max < a[i] then max := a[i]; writeln('Максималный эл-т = ', max); end; begin wwod; maxwiwod; readln; end.

Ответ отправил: Костя Симанович (статус: 4-ый класс) Ответ отправлен: 27.05.2008, 14:32 Оценка за ответ: 5

Отвечает: Шемет Станислав Васильевич Здравствуйте, Пухов Никита Евгеньевич! Программа в приложении .... Удачи))) Приложение: const n=100; Var M:array[1..n] of integer; Procedure Vvod; var I:integer; begin For I:=1 to n do Begin Write('Елемент №: ',i,' ='); Readln(m[i]); end; end; Procedure Vuvod; var i,Temp:integer; Begin temp:=m[1]; For i:=2 to n do if temp<m[i] then temp:=m[i]; Writeln('Максимальный элемент'); end; Begin Vvod; Vuvod; Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 7-ой класс) Ответ отправлен: 27.05.2008, 16:58 Оценка за ответ: 5

Вопрос № 138.078

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пухов Никита Евгеньевич! Решение задачи в приложении. Не забудьте создать текстовый файл, в котором в строку через пробел запишите данные точно, как в условии. Каждого служащего с новой строки без отступа. Пишите в файле английскими буквами, иначе программа ничего, кроме чисел не прочитает. Приложение: uses crt; var f:text; {текстовый файл} s,s1:string;{основная и вспомогательная строки} dlz:string; {вводимая с клавиатуры должность} i,k:byte; c:integer; okl:word; {оклад} begin clrscr; assign(f,'spisok.txt');{связываем переменную f с именем файла} reset(f); {открываем его для чтения} writeln('Oklad<2000:'); writeln; k:=0; while not eof(f) do begin readln(f,s); {считываем очередную строку} s1:=s; {запоминаем ее} while pos(' ',s)>0 do delete(s,1,pos(' ',s)); {удаляем из строки все, кроме последнего слова(оклад)} val(s,okl,c); {преобразуем строку в число} if okl<2000 then begin k:=k+1; {считаем строку} writeln(s1); {выводим запомненную строку на экран} end; end; if k=0 then writeln('Takih net!'); {если к=0, выводим сообщение} close(f); {закрываем файл} reset(f); {снова открываем} writeln; write('Dolznost: ');readln(dlz);{} writeln; k:=0; while not eof(f) do begin readln(f,s); s1:=s; delete(s,1,pos(' ',s)); {удаляем первые два слова} delete(s,1,pos(' ',s)); {если введенная должность = третьему слову, то считаем и выводим} if dlz=copy(s,1,pos(' ',s)-1) then begin k:=k+1; writeln(s1); end; end; if k=0 then writeln('Takogo net!'); readln; close(f); end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 27.05.2008, 15:53 Оценка за ответ: 5

Вопрос № 138.101

Доброго времени суток эксперты. При решении задач возникли проблемы, прошу помочь: 1) Дана целочисленная прямоугольная матрица. поменять местами строки,у которых разность сумм минимальна(оформить в виде подпрограммы). Проблема: Не могу понять как сделать так чтоб он искал разность и минимальное одновременно. 2) Дана целочисленная матрица. Определить сумму элементов в тех столбцах, которые не содержат отрицательных элементов(оформить ввиде функции). Проблема: Задачу реализовал, в теории все должно правильно быть, но на практике какая то чушь. Помогите найти ошибку 3) Дана целочисленная матрица. Вывести номер строки, в которой находится самая длинная серия одинаковых элементов(оформить ввиде процедуры). Проблема: решил, но где то есть ошибка. проверьте пожалуйста Приложение: 2) uses crt; const n=6;m=7; var D:array[1..n,1..m] of integer; k,sum:array[1..n] of integer; i,j:byte; x:integer; procedure MikkiMous(var x:integer); var i,j:byte; {локальные переменные} begin for j:=1 to m do for i:=1 to n do if d[i,j]<0 then inc(k[j]); for j:=1 to n do writeln(k[j]); for j:=1 to m do for i:=1 to n do if k[j]=0 then sum[j]:=sum[j]+d[i,j]; for j:=1 to m do write(sum[j]:2); end; begin clrscr; {основная программа} randomize; writeln('Matrix'); { Формирование массива} for i:=1 to n do for j:=1 to m do d[i,j]:=random(11)-1; for i:=1 to n do begin for j:=1 to m do write(d[i,j]:5); writeln;end; mikkiMous(x); readln; end. 2) uses crt; const n=6;m=7; var a:array[1..n,1..m] of integer; st,i,j,max:integer; k:array[1..n] of integer; begin clrscr; randomize; for i:=1 to n do for j:=1 to m do begin a[i,j]:=random(3); ;end; for i:=1 to n do begin for j:=1 to m do write(a[i,j]:3); writeln;end; for i:=1 to n do for j:=1 to m do if a[i,j]=a[i,j+1] then inc(k[i]); for i:=1 to n do writeln(k[i]:3); max:=k[1]; for i:=1 to n do if k[i]>max then begin max:=k[i]; st:=i; end; writeln('max: ',max,' stroka: ',st); repeat until keypressed; end.

Отправлен: 27.05.2008, 16:44 Вопрос задал: DaImeR (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Пупорев Юрий Борисович Здравствуйте, DaImeR! По задаче 2. Ошибки есть и много. Разбирать их я не буду, это много писанины. Лучше я напишу как надо и объясню. Решение этой задачи и задачи №1 в приложении. С третьей задачей сходу не разобрался. Сначала задача 2, в ней комментариев больше, потом №1. Добавил задачу №3. С вашей попыткой решить ничего общего, поэтому ваш вариант не разбираю. Приложение: Задача 2. uses crt; const n=6; m=7; {для передачи параметров матрицы в процедуру, чего у вас не было сделано, создадим тип матрицы, т.к. прямо в параметрах процедуры его указывать нельзя} type Tmatr=array[1..n,1..m] of integer; var D:Tmatr; sum,k:integer; i,j:byte; procedure MikkiMous(d:Tmatr); {если есть глобальные переменные счетчиков строк и столбцов, то в локальных их повторять не надо, хотя можно, например в Делфи это обязательно} var sum,k:integer; {эти переменные только локальные, т.к. используются только внутри процедуры} begin for j:=1 to m do {если в цикле выполняется более одной операции, нужно его заключать в блок begin … end;} begin k:=0;sum:=0; for i:=1 to n do if d[i,j]>=0 then {считаем не отрицательные, а наоборот, чтобы не делать лишний цикл} begin inc(k); {считаем неотрицательные} sum:=sum+d[i,j];{считаем сумму} end; if k=n then writeln('Summa v stolbce ',j, '=',sum); {если все неотрицательные, выводим сумму в строке на экран} end; end; begin clrscr; randomize; writeln('Matrix'); {создавать и выводить на экран матрицу можно в одном цикле} for i:=1 to n do begin for j:=1 to m do begin d[i,j]:=random(11)-2; write(d[i,j]:5); end; writeln; end; mikkiMous(d); readln; end. Задача 1. uses crt; const n=5; m=6; type Tmatr=array[1..n,1..m]of integer; {тип матрицы для передачи параметров матрицы в процедуру} var a:Tmatr; i,j:integer; {Процедура принимает параметры матрицы и выдает их измененными, поэтому var} Procedure RazStr(var a:Tmatr); var b:array[1..n]of integer; {локальные переменные} sum,raz,min,imin1,imin2,x:integer; begin writeln('Summa v strokah:'); {считаем сумму в каждой строке и записываем их в массив} for i:=1 to n do begin sum:=0; for j:=1 to m do sum:=sum+a[i,j]; b[i]:=sum; write(b[i],' ');{выводим для проверки} end; writeln; {ищем минимальную разницу между элементами массива и запоминаем их номера} min:=abs(b[1]-b[2]);imin1:=1;imin2:=1; for i:=1 to n-1 do for j:=i+1 to m do if (abs(b[i]-b[j])<min)and(i<>j) then begin min:=abs(b[i]-b[j]); imin1:=i; imin2:=j; end; writeln('imin1=',imin1,' imin2=',imin2);{выводим для контроля} for j:=1 to m do {меняем местами элементы нужных строк} begin x:=a[imin1,j]; a[imin1,j]:=a[imin2,j]; a[imin2,j]:=x; end; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:3); writeln; end; end; begin clrscr; randomize; writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); write(a[i,j]:3); end; writeln; end; RazStr(a); readln end. Задача №3. uses Crt; const n=5; m=10; type Tmatr=array[1..n,1..m] of integer; Tmass=array[1..m] of integer; var a:Tmatr; i,j,nstr:byte; Procedure DlInt(a:Tmatr;var nstr:byte); {входной параметр- матрица, выходной – номер строки} var st,x,k,max,mxint:integer; begin nstr:=1;mxint:=0; for i:=1 to n do begin st:=-1;max:=0; for j:=2 to m+1 do begin if a[i,j-1]=a[i,j] then begin if st<0 then st:=j-1;{сдвигаем интервал} end else if st>0 then {конец интервала} begin k:=j-st; {длина интервала} if k>max then max:=k; {наибольшая длина интервала} st:=-1; {переходим к следующей серии} end; end; if max>mxint then {если в данной строке больше, чем в предыдущих} begin mxint:=max;{значит это максимум} nstr:=i; {а это номер нужной строки} end; end; end; begin ClrScr; randomize; writeln('Matrica:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(3); write(a[i,j]:3); end; writeln; end; writeln; DlInt(a,nstr); writeln('Nomer strki s samoj dlinnoj seriej=',nstr); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 28.05.2008, 09:14 Оценка за ответ: 5 Комментарий оценки: Хороший и довольно понятный ответ. Большое спасибо

Вопрос № 138.116

Дан одномерный массив B состоящий из 10 элементов. Найти максимальный и минимальный элементы данного массива.

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

Отвечает: S K A L T Здравствуйте, Sanq4! Сначала считаем что максимальный элемент первый, затем если найдеться элемент больше первого, то присваиваем ему значение max. Приложение: uses crt; const n=10; type mas=array[1..n] of integer; var i:integer; m:mas; max,min:integer; begin randomize; For i:=1 to n do m[i]:=random(200)-100; max:=0; min:=0; max:=m[i]; for i:=1 to n do if M[i+1]>max then max:=m[i+1]; writeln('max:=',max); writeln; min:=m[i]; for i:=1 to n do if M[i]<min then min:=M[i]; writeln('min=',min); writeln; for i:=1 to n do write(m[i]:5); readln; end.

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 28.05.2008, 13:16

Вопрос № 138.118

Написать функцию, в коорой подсчитывается сумма элементов одномерного массива MAS размерностью N.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Sanq4! Решение задачи в приложении. Задача настолько простая, что не знаю, что комментировать. Приложение: uses crt; type Tmass=array[1..100]of integer; var a:Tmass; n,i:integer; function Summ(p:Tmass;q:integer):integer; {в параметры функции передаем массив и его размерность} var sm:integer; begin sm:=0; for i:=1 to q do sm:=sm+p[i]; Summ:=sm; end; begin clrscr; randomize; write('Vvedite razmernost massiva n='); readln(n); writeln('Massiv:'); for i:=1 to n do begin a[i]:=random(10); write(a[i],' '); end; writeln; Writeln('Summa elementov massiva=',Summ(a,n));{вызываем функцию} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 28.05.2008, 13:37

Вопрос № 138.120

Написать процедуру для нахождения среднего арифметического числа в одномерном массиве B размерностью N.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Sanq4! Задача с пояснениями в приложении. Прцедуру я назвал GetSA. Удачи!!! Приложение: const N=10; {B-массив, n-кол-во элементов в массиве, SA- переменная куда сохранить результат} procedure GetSA(B: array of integer; n: integer; var SA: real); var {sum-сумма элементов массива, i-счетчик для For} Sum, i: integer; begin {Инициализируем сумму} sum:=0; {В цикле перебираем весь массив и вычисляем сумму} for i:=0 to n-1 do inc(sum, B[i]); {вычисляем среднее арифметическое} SA:=sum/n; end; var {i-счетчик для For, sa-среднее арифметическое, a-массив} i: integer; SA: real; a: array [1..N] of integer; begin randomize; {В цикле заполняенм массив случайными числами и выводим их через пробел} for i:=1 to N do begin a[i]:=random(50)-25; write(a[i], ' '); end; {Получаем ср. арифм.} GetSa(a, N, SA); writeln; {вывод} write('Ср. арифм.: ', SA:8:3); readln; end.

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

Вопрос № 138.123

Написать программу, которая вычисляет, сколько раз введённое с клавиатуры число встречается в одномерном массиве A размерностью N элементов.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Sanq4! Задача с пояснениями в приложении. Удачи!!! Приложение: const {Длина массива} N=10; var {val-число, i-счетчик для For, count-кол-во} Val, i, count: integer; {массив} a: array [1..N] of integer; begin {Получаем число} write('Введите число: '); readln(Val); {Инициализируем счетчик} count:=0; randomize; {В цикле For...} for i:=1 to N do begin {...Заполняем массив случайными числами} a[i]:=random(10)-5; {выводим через пробел} write(a[i], ' '); {если оно равно заданному числу,} if a[i] = Val then {То увеличиваем счетчик на 1} inc(count); end; writeln; {вывод} Write(count); readln; end.

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

Отвечает: Jones Здравствуйте, Sanq4! Код Вашей программы в приложении. Пишем правильно. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 27.05.2008, 23:17 (MCK) Приложение: uses crt; var a:array [1..20] of integer; i,n,b,kol:integer; begin clrscr; writeln ('vvedite kol-vo elementov'); readln (n); writeln ('vvedite chislo a'); readln(b); kol:=0; writeln ('vvedite massiv'); for i:= 1 to n do begin writeln ('vvedite ocherednoy element'); readln (a[i]); if a[i]=b then inc(kol); end; write ('kol-vo elementov ravnyh ',b,' ravno ',kol); readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 27.05.2008, 23:03

Вопрос № 138.128

Дан одномерный массив, состоящий из N элементов, найти сумму отрицательного и положительного элементов данного массива.

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

Отвечает: Jones Здравствуйте, Sanq4! Код Вашей программы в приложении. Пишем правильно. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 27.05.2008, 23:18 (MCK) Приложение: uses crt; var a:array [1..20] of integer; i,n,pol,otr:integer; begin clrscr; writeln ('vvedite kol-vo elementov'); readln (n); pol:=0;otr:=0; writeln ('vvedite massiv'); for i:= 1 to n do begin writeln ('vvedite ocherednoy element'); readln (a[i]); if a[i]>0 then inc(pol,a[i]); if a[i]<0 then inc(otr,a[i]); end; writeln ('summa polozhitelnyh elementov ravna ',pol); writeln ('summa otricatelnyh elementov ravna ',otr); readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 27.05.2008, 22:58

Вопрос № 138.134

Написат программу длянахождения количества элементов одномерного массива B, которое больше введённого с клавиатуры числа A.

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

Отвечает: Костя Симанович Здравствуйте, Sanq4! Решние задачи в приложении с пояснениями. Строки "для примера" можно удалить. Массив имеет 10 значений, но можно увеличить если надо. Приложение: program mass1; const n = 10; {кол-во эл-ов массива} var m : array[1..n] of integer; i : integer; kol: integer; a : real; begin kol := 0; {массив будем заполнять случайными числами} {например от 1 до 100} randomize; {готовимся к случайному заполнению} for i := 1 to n do {заполняем случайными числами} begin m[i] := random(100) + 1; {случайнае числа от 1 до 100 можно менять} write(m[i], ' '); {выводим массив для примера} end; writeln('введите число А'); readln(a); writeln; {ищем числа которые больше А и их кол-во} for i:= 1 to n do if m[i] > a then begin kol := kol + 1; {увеличиваем на 1} write(m[i], ' '); {выводим эл-т массива для примера} end; writeln; writeln('Кол-во эл-ов больше ', a:2:2, ' = ', kol); readln; end.

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

Отвечает: Jones Здравствуйте, Sanq4! Код Вашей программы в приложении. Пишем правильно. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 27.05.2008, 23:18 (MCK) Приложение: uses crt; var b:array [1..20] of integer; i,n,a,kol:integer; begin clrscr; writeln ('vvedite kol-vo elementov'); readln (n); writeln ('vvedite chislo a'); readln(a); kol:=0; writeln ('vvedite massiv'); for i:= 1 to n do begin writeln ('vvedite ocherednoy element'); readln (b[i]); if b[i]>a then inc(kol); end; write ('kol-vo elementov bol''shih a ravno ',kol); readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 27.05.2008, 22:50

Отвечает: S K A L T Здравствуйте, Sanq4! вводим стандартный цикл который проверяет каждый элемент и находит нужный нам по условию. Приложение: uses crt; type mas=array[1..100] of integer; var i,a,i1:integer; m:mas; n:integer; begin randomize; write('vvedite kol-vo elementov'); readln(n); For i:=1 to n do m[i]:=random(200)-100; Writeln('ishodni massiv'); for i:=1 to n do write(m[i]:5); writeln; begin i1:=0; writeln('veddite chislo');readln(a); for i:=1 to n do begin if m[i]>a then begin inc(i1);end;end;end; writeln('kol-vo elementov',i1);readln; end.

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 28.05.2008, 13:10

Вопрос № 138.136

Дан одномерный массив C, состоящий из N вещественных чисел. Найти сумму элементов данного массива.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Sanq4! Задача в приложении. В цикле For заполняем массив случайными числами с помощью функции random, выводим его на экран и прибавляем к сумме только что заполненный элемент массива. Тип переменной которая хранит сумма - real, т.к. тип массива тоже real. В начале программы нужно проинициализировать нулем переменную, которая хранит сумму, если этого не сделать, то переменная будет хранить всякий "мусор" и программа выдаст не верный результат! Удачи!!! Приложение: const {Длина массива} N=10; var {Массив из N элементов} C: array [1..N] of real; i: integer; {Сумма(тип real!)} sum: real; begin {Инициализация суммы} sum:=0; randomize; {Цикл For} for i:=1 to N do begin {случайное число} C[i]:=random(100)-50+random; {Вывод} write(c[i]:8:3); {Прибавка к сумме} sum:=sum+c[i]; end; writeln; {Вывод рез-ов} Write('Сумма элементов массива: ', sum:8:3); readln; end.

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

Отвечает: Jones Здравствуйте, Sanq4!При вводе массива сразу подсчитываем сумму. Код в приложении. Приложение: uses crt; var c:array [1..20] of real; i,n:byte;sum:real; begin clrscr; writeln ('vvedite kol-vo elementov'); readln (n); sum:=0; for i:=1 to n do begin writeln ('vvedite ocherednoy element'); readln (c[i]); sum:=sum+c[i]; end; write ('summa elementov massiva ravna ',sum:10:4); readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 27.05.2008, 22:40

Отвечает: Шемет Станислав Васильевич Здравствуйте, Sanq4! Программа в приложении.... Удачи=)))) Приложение: const n=10; Var C:array[1..n] of real; sum:real; I:integer; Begin Randomize; For i:=1 to n do c[i]:=Random(i)/(random(i)+1); sum:=0; For i:=1 to n do sum:=sum+c[i]; Writeln(sum); REadln; end. --------- Любовь это прекрасно!!!

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

Вопрос № 138.149

люди добрые помогите,буду очень благодарен!!!срочно нада решить: Составить программу для вычисления суммы ряда с заданно точностью E , если известна формула для вычисления общего член ряда ai. ai=((х/3) все в степени i заранее очень балгодарен!!!!!!!!!!!!!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Петров Игорь Ильич! Решение задачи с пояснениями в приложении. Приложение: uses crt; var x,e,sum,y,yi:double;{тип Real в вычислениях лучше не использовать} i:integer; begin clrscr; repeat {проверяем на правильность ввода} write('Vvedite znachenie x<3 x='); readln(x); if x>=3 then writeln('Reshenja net! Vvedite x<3!'); until x<3; write('Vvedite tochnost vychislenij e='); readln(e); i:=1;y:=x/3;sum:=0;yi:=1; while abs(y-yi)>e do {пока разница между текущим членом и предыдущим больше погрешности} begin y:=yi; {текущему члену присваиваем значение предыдущего} yi:=yi*(x/3);{считаем очередной член} sum:=sum+yi; {считаем сумму} i:=i+1; {переходим к следующему члену} end; writeln('Summa=',sum:6:3); readln end.

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

Вопрос № 138.156

Найти минимальный и максимальный элементы массива D и по- менять их местами( в массиве) и вывести на экран измененный массив.

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

Отвечает: Костя Симанович Здравствуйте, Петров Игорь Ильич! Пдробное решение в приложении, с коментариями. Массив заполняеся сучайными числами от 1 до 100, кол-во 10 это всё можно поменять по Вашему жеаню. Надеюсь помог. Удачи. Отредактировано по просьбе эксперта. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 28.05.2008, 21:30 (MCK) Приложение: program mass2; const n = 10; {кол-во эл-ов массива} var m : array[1..n] of integer; i : integer; min, max : integer; min1, max1 : integer; {номер мах и мин эл-та} begin min1 := 1; max1 := 1; {массив будем заполнять случайными числами} {например от 1 до 100} randomize; {готовимся к случайному заполнению} for i := 1 to n do {заполняем случайными числами} begin m[i] := random(100) + 1; {значение можно изменить} write(m[i], ' '); {выводим массив для примера} end; writeln; {ищем максимальное и минимальное} max := m[1]; min := m[1]; for i:= 2 to n do begin if m[i] > max then begin max := m[i]; max1 := i; end; if m[i] < min then begin min := m[i]; min1 := i; end; end; {меняем местами} m[max1] := min; m[min1] := max; writeln; writeln('Максимальный эл-т = ', max, ' Минимальный эл-т = ', min); writeln; {выводим изменённый массив} for i:= 1 to n do write(m[i], ' '); readln; end.

Ответ отправил: Костя Симанович (статус: 4-ый класс) Ответ отправлен: 27.05.2008, 22:14 Оценка за ответ: 5 Комментарий оценки: спсибо большое

Отвечает: Jones Здравствуйте, Петров Игорь Ильич! Код в приложении Приложение: uses crt; var a:array [1..20] of integer; i,n,max,min,imax,imin,b:integer; procedure vyvod; begin for i:=1 to n do write (a[i],' '); writeln; end; begin clrscr; writeln ('vvedite kol-vo elementov'); readln (n); max:=low(integer);min:=high(integer); writeln ('vvedite massiv'); for i:= 1 to n do begin writeln ('vvedite ocherednoy element'); readln (a[i]); if max<a[i] then begin max:=a[i];imax:=i;end; if min>a[i] then begin min:=a[i];imin:=i;end; end; writeln ('dannyi massiv'); vyvod; a[imin]:=max;a[imax]:=min; writeln('obrabotannyi massiv'); vyvod; readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 27.05.2008, 22:26 Оценка за ответ: 5 Комментарий оценки: срасибо большое очень благодарен

Вопрос № 138.163

Уважаемые эксперты! Помогите, пожалуйста, решить задачу: 1. Дан массив данных об автомобилях заводского гаража (Формирование массива из файла и таким образом, чтобы в каждой строчке была вся информация по конкретному автомобилю): номер, марка, год выпуска, пробег, фамилия шофёра. Вывести: - сообщение о том, есть ли в гараже автомобиль заданной марки (да или нет) (с помощью цикла While); - список машин, подготовленных на списание (старше 1980 года с пробегом более 50 000км), в списке указаны все данные, кроме фамилии шофёра; -все записи, упорядоченные по признаку: фамилии шофёров в алфавитном порядке. Заранее огромное спасибо! Swallow.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ласточка! Видимо решение этой задачи в ответе на вопрс №136832 через типизированный файл Вас не устроило. Предлагаю решение с использованием текстового файла. Создайте файл, заполните его данными – в каждой строке через пробел сведения об одной машине. Следующая с новой смтроки без отступа. Текстовые данные пишите латиницей, иначе программа не сможет работать с этим текстом. Код в приложении. Рабочая часть кода (запросы)не изменилась, поэтому не комментирую. Приложение: uses crt; type Tgaraz=record {запись с полями по условию} nom:string[20]; mar:string[20]; god:word; prb:longint; fam:string[20]; end; var sp:array[1..100] of Tgaraz; {массив записей – список машин} n,c,i,k,j:integer; {разные счетчики, с-переменная в процедуре Val} s,m:string; {считываемая строка и переменная при вводе марки} buf:Tgaraz; {буфер типа запись при сортировке обменом} f:text; {переменная для связи с текстовым файлом} gd:word; {переменная при определении года} pr:longint; {переменная при определении пробега} begin clrscr; assign(f,'Spisok.txt'); {связываем переменную с файлом } reset(f); { открываем его для чтения } n:=0; while not eof(f)do begin readln(f,s); {считываем очередную строку} n:=n+1; {считаем ее} sp[n].nom:=copy(s,1,pos(' ',s)-1); {первое слово - номер} delete(s,1,pos(' ',s)); {удаляем его} sp[n].mar:=copy(s,1,pos(' ',s)-1); {второе слово - марка} delete(s,1,pos(' ',s)); val(copy(s,1,pos(' ',s)-1),gd,c); {третье слово – год - превращаем в число} sp[n].god:=gd; {присваиваем полю записи} delete(s,1,pos(' ',s)); {то же с четвертым словом - пробег} val(copy(s,1,pos(' ',s)-1),pr,c); {} sp[n].prb:=pr; {} delete(s,1,pos(' ',s)); sp[n].fam:=s; {последнее слово - фамилия} end; writeln; write('Vvedite marku mashiny:'); readln(m); k:=0; for i:=1 to n do if sp[i].mar=m then begin k:=k+1; end; if k>0 then writeln('Takaja marka est!') else writeln('Takoj marki net!'); writeln; writeln('Spisok mashin k spisaniu:'); for i:=1 to n do if (sp[i].god<1980)and(sp[i].prb>50000)then begin write('Nomer ',sp[i].nom,' Marka ',sp[i].mar); write(' God vypuska ',sp[i].god,' Probeg ',sp[i].prb); writeln; end; writeln; writeln('Spisok po familii shofera:'); for i:=1 to n-1 do for j:=1 to n-1 do if sp[j].fam>sp[j+1].fam then begin buf:=sp[j]; sp[j]:=sp[j+1]; sp[j+1]:=buf; end; for i:=1 to n do begin write(' Familia ',sp[i].fam,' Nomer ',sp[i].nom,' Marka ',sp[i].mar); write(' God vypuska ',sp[i].god,' Probeg ',sp[i].prb); writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 27.05.2008, 22:01 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо вам за решение, Юрий Борисович !!!!!! Извините, что сразу не уточнила условия задачи.

Вопрос № 138.288

Дыны числа Р и Н. Определить сумму чисел меньше Р, произведение чисел больше Н и количество чисел больше Н и количество чисел в диапазоне значений Р и Н. При вводе числа равного Р или Н закончить роботу. Приложение: Помогите пожалуйста

Отправлен: 28.05.2008, 14:52 Вопрос задала: Света Кузнецова (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Света Кузнецова! Решение с комментариями в приложении. Успехов на Роллан Гаррос! (шутка). Приложение: uses crt; var a,p,h,sum,pr,kh,kph:integer; begin clrscr; write('p=');readln(p); repeat {проверяемость на ввод числа Р, чтобы больше Н} write('h=');readln(h); if h<=p then writeln('Vvedite h>p!'); until h>p; {конец проверки} sum:=0;pr:=1;kph:=0;kh:=0; repeat write('Vvedite chislo: '); {в цикле вводим число} readln(a); if a<p then sum:=sum+a {если <р, считаем сумму} else if (a>=p)and(a<=h)then {если в интервале} kph:=kph+1 {считаем количество} else if a>h then {если больше Н} begin pr:=pr*a; {считаем произведение} kh:=kh+1; {считаем количество} end; until (a=p)or(a=h); {заканциваем ввод} writeln; writeln('Summa chisel<p=',sum); writeln('Proizvedenie chisel>h [p,h]=',pr); writeln('Kolichestvo chisel >h [p,h]=',kh); writeln('Kolichestvo chisel v intervale [p,h]=',kph); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 29.05.2008, 07:12 Оценка за ответ: 5

Вопрос № 138.300

Здравствуйте,очень нужна помощь! Не могу подсчитать количество устройств введенных с клавиатуры(см.приложение),как правильно записать условие,чтоб подсчитывало количество устройств введеных с клавиатуры? Заранее спасибо:) Приложение: Program zadacha; uses wincrt; type TDevice = record marka : string; category : char; year : integer; company : string; colors : byte; resolution : integer; format : string; end; var Fdevice:FILE OF tdevice; device:tdevice; n: byte; kolvo:integer; i:byte; k:char; B:integer; CATEGORY:string; FILENAME:string; begin WRITELN ('Введимте полный путь и имя файла: '); READLN(FILENAME); ASSIGN (fdevice,filename); REWRITE(fdevice); WRITE ('Введите количество устройств: '); READLN(n); for i:=1 TO N DO BEGIN WRITELN('Введите данные об ',I,' устройствах: '); writeln; WriteLn('Vvedite marku:'); ReadLn(devICE.marka); WriteLn('Vvedite kategoriyu:'); ReadLn(devICE.category); WriteLn('Vvedite god vypuska:'); ReadLn(devICE.year); WriteLn('Vvedite proizvoditelya:'); ReadLn(devICE.company); WriteLn('Vvedite kol-vo cvetov:'); ReadLn(devICE.colors); WriteLn('Vvedite razreshenie:'); ReadLn(devICE.resolution); WriteLn('Vvedite format bumagi:'); ReadLn(devICE.format); write(FDEVICE,DEVICE); WriteLn; end; WRITELN('Формирование файла закончено!'); CLOSE(fdevICE); WRITELN('содержание файла: '); reset(FDEVICE); WHILE NOT EOF(fdevice) DO BEGIN read(FDEVICE,DEVICE); writeln('*************************************************************'); writeln('Год выпуска|Компания|Разрешение|Формат|Цвета|Категория|Марка|'); WRITELN('*************************************************************'); writeln(DEVICE.YEAr:11,'|',devICE.company:8,'|',devICE.resolution:10,'|',devICE.format:6,'|', devICE.colors:5,'|',devICE.category:9,'|',devICE.marka:5,'|'); WRITELN('*************************************************************'); kolvo:=0; if device.category=k then kolvo:=kolvo+1; end; CLOSE(fdevICE); WRITELN('Введите категорию печатающего устройства: '); READLN(k); WRITELN ('Количество устройств: ',k); END.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Георгий Т! Насколько я понял, Вам нужно найти кол-во записей в типизированном файле. Для этого есть функция FileSize. Она возвращает текущий размер файла. Первый и единственный параметр - это типизированный файл. Вот не большой пример: var  f: file of PointType;  size: integer; begin  assign(f, 'file');  reset(f);  size:=FileSize(f);  write('Кол-во записей: ', size);  close(f); end. В пирмере открывается типизированый файл file, и в переменную size сохраняем кол-во записей в файле. Надеюсь, помого Вам. Удачи!!! Приложение: function FileSize(var F): LongInt;

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 28.05.2008, 16:11 Оценка за ответ: 5

Вопрос № 138.341

Написать программу, которая методом обмена, сортирует по возрастанию введённый с клавиатуры омерный массив размерностью N.

Отправлен: 28.05.2008, 18:19 Вопрос задал: бывает Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, ! Программа в приложении. При работе программы подсвечивается элементы которые обмениваются. Удачи! Приложение: uses crt; const n=9; type mass=array[1..n]of real; var a:mass; i:integer; {процедура будет вызыватся рекурсивно} procedure Sort(var aa:mass); var x:integer; j:real; begin {запускаем цикл проверки} for x:=1 to n-1 do if aa[x]>aa[x+1] then begin {обмениваем соседние элементы массива} j:=aa[x]; aa[x]:=aa[x+1]; aa[x+1]:=j; {вывод для контроля} for i:=1to n do begin {только для подсветки перестановок} if (i=x)or(i=(x+1)) then TextColor(15); write(aa[i]:8:4); TextColor(7); end; writeln; {вызываем саму себя с новым расположением элементов массива} Sort(aa); end; {сортировка закончилась} end; begin randomize; for i:=1 to n do begin {ввод массива} write('Enter a[',i,']:='); readln(a[i]); end; writeln; writeln; {сортируем массив} Sort(a); writeln; {выводим результат сортировки массива} for i:=1 to n do write(a[i]:8:4); writeln; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Костя Симанович !!! Здравствуйте, бывает! В решении каждый элемент массива, начиная с первого, сравниваем со следующим, и если он больше следующего, то элементы меняются местами. Удачи! В ответе реализована сортировка включением. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 28.05.2008, 22:27 (MCK) Приложение: program sort; const n = 10; {кол-во эл-ов массива} var m : array[1..n] of integer; i, j, x : integer; begin for i := 1 to n do {заполняем массив числами} begin writeln('Введите ', i, ' элемент. '); readln(m[i]); end; {выводим до сортировки для наглядности} for i := 1 to n do write(m[i], ' '); {сортируем методом обмена "пузырька"} for i := 1 to n - 1 do for j := i + 1 to n do if m[i] > m[j] then {если больше следующего} begin {то меняем местами} x := m[i]; m[i] := m[j]; m[j] := x; end; {выводим результат} writeln; for i := 1 to n do write(m[i], ' '); readln; end.

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

Вопрос № 138.342

дан одномерный массив, Состоящий из N элементов, найти сумму положиельных элементов данного массива.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, бывает! Задача с пояснениями в приложении. Удачи!!! Приложение: const {Длина массива} N=10; var {a-массив, sum-сумма, i-счетчик для For} a: array [1..N] of integer; sum, i: integer; begin {Инициализируем сумму} sum:=0; {Включаем генератор случайных чисел} randomize; WriteLn('Исходный массив: '); {В цмкле проходим по всему массиву и...} for i:=1 to n do begin {...заполняем его случайными числами...} a[i]:=random(50)-25; {...выводим на экран через пробел...} write(a[i], ' '); {...если число положительное...} if a[i] > 0 then {...то прибавляем его к сумме} sum:= sum + a[i]; end; writeln; {вывод} write('Сумма положительных элементов: ', sum); readln; end.

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

Вопрос № 138.343

Дан одномерный массив, состоящий из N элементов. Поменять местами максимальный и минимальный элементы данного массива.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, бывает! Смотрите приложение. Удачи! Приложение: const n=10; var a:array[1..n]of integer; b,c,d:integer; begin {создаем массив} randomize; for b:=1 to n do begin a[b]:=random(200); write(a[b]:4); end; writeln; {ищем минимальный и максимальный} c:=1;d:=1; for b:=1 to n do begin if a[c]>a[b]then c:=b; if a[d]<a[b]then d:=b; end; {меняем местами и выводим} b:=a[c]; a[c]:=a[d]; a[d]:=b ; for b:=1 to n do write(a[b]:4); writeln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.344

Написать процедуру для ввода элементов одномерного массива MAS размерностью N. Дан одномерный массив, состоящий из N элементов, найти сумму отрицательных элементов данного массива.

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

Отвечает: Jones Здравствуйте, бывает! Код в приложении.... Код в приложении.... Приложение: uses crt; const n=5; var mas: array [1..n] of integer; i:byte;sum:integer; procedure vvod; begin for i:=1 to n do begin writeln ('vvedite element'); readln (mas[i]); end; end; begin clrscr; vvod; for i:= 1 to n do if mas[i]<0 then sum:=sum+mas[i]; writeln ('summa otr elementov = ',sum); readln; end.

Ответ отправил: Jones (статус: 1-ый класс) Ответ отправлен: 28.05.2008, 21:31

Вопрос № 138.354

Уважаемые эксперты! Помогите, пожалуйста, решить задачу: Дан массив данных о результатах уборки ржи в хозяйствах района(формирование массива из текстового файла): название хозяйства, общая посевная площадь(га), площадь посевов ржи(га), величина урожая(в центнерах), фамилия председателя). Вывести: -названия хозяйств и фамилии их председателей, где урожай собран выше среднего уровня; -сообщение о том, есть ли хозяйства, где урожайность ржи превышает заданную величину(да или нет); -все записи, упорядоченные по признаку: убывание величины урожая. Заранее огромное спасибо! Swallow.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ласточка! Задача практически аналогична предыдущей, поэтому особо распространяться не буду. Решение с небольшими комментариями в приложении. Чтобы не заморачиваться с форматированием вывода данных, делайте ширину одноименных полей в файле (кроме фамилий) одинаковыми. Прилагаю примерное содержание текстового файла. Приложение: uses crt; type Turoz=record naz:string[20]; {название} plo:word; {общая площадь} plr:word; {площадь ржи} chn:word; {урожай-центнеры} fam:string[20]; {фамилия} urz:real; {урожайность-урожай/площадь ржи} end; var sp:array[1..100] of Turoz; n,c,i,k,j:integer; {разные счетчики} s:string; {строка для вывода из файла} buf:Turoz; {буфер при сортировке} f:text; {текстовый файл} zur,srur:real; {заданная урожайность, средний урожай} po,pr,ur:word; {переменные при переводе строк в число} begin clrscr; assign(f,'Urozaj.txt'); reset(f); n:=0; while not eof(f)do begin readln(f,s); n:=n+1; sp[n].naz:=copy(s,1,pos(' ',s)-1); delete(s,1,pos(' ',s)); val(copy(s,1,pos(' ',s)-1),po,c); sp[n].plo:=po; delete(s,1,pos(' ',s)); val(copy(s,1,pos(' ',s)-1),pr,c); sp[n].plr:=pr; delete(s,1,pos(' ',s)); val(copy(s,1,pos(' ',s)-1),ur,c); sp[n].chn:=ur; delete(s,1,pos(' ',s)); sp[n].fam:=s; sp[n].urz:=sp[n].chn/sp[n].plr; end; writeln('Urozaj vyshe srednego:'); writeln; srur:=0; for i:=1 to n do begin srur:=srur+sp[i].chn;{сумма} end; srur:=srur/n; {среднее} for i:=1 to n do if sp[i].chn>srur then begin writeln('Hoziajstvo ',sp[i].naz,'; Familia ',sp[i].fam); end; readln; write('Vvedite zadannujy urozajnost zur='); readln(zur); k:=0; for i:=1 to n do if sp[i].urz>zur then begin k:=k+1; end; if k>0 then writeln('Takie hoziajstva est!') else writeln('Takih hoziajstv net!'); readln; writeln('Spisok hoziajstv po urozaju:'); writeln; for i:=1 to n-1 do for j:=1 to n-1 do if sp[j].chn<sp[j+1].chn then {сортировка по убыванию} begin buf:=sp[j]; sp[j]:=sp[j+1]; sp[j+1]:=buf; end; for i:=1 to n do begin write('Hoziajstvo ',sp[i].naz,' Obsh. plosh. ',sp[i].plo); write(' Plosh. rzi ',sp[i].plr,' Urozaj ',sp[i].chn,' Familia ',sp[i].fam); writeln; end; readln end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

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

Вопрос № 138.360

Уважаемые эксперты помогите сделать задачу : Напишите собственную функцию(или процедуру) без обращений к системным функциям, которая берет строку, которая содержит цифры (например "256") и возвращает соответствующее целое число типа int. Также написать программу, которая осуществляет вызов этой функции.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Xbondx! Программа в приложении. Контроля вводимых данных нет, из-за этого вводе любого символа кроме цифр даст неправильный результат. Если нужен контроль данных, обращайтесь в мини-форум. Удачи! Приложение: var a:string[5]; function StrToInt(i:integer):integer; begin if i>0 then StrToInt:=10*StrToInt(i-1)+ord(a[i])-ord('0') else StrToInt:=0; end; begin write('Enter string:'); readln(a); writeln('Integer:',StrToInt(length(a)):5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 28.05.2008, 21:18 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 138.396

помогите написать две програмы на паскале пожалуйста. Заранее спасибо! 1) Записать в текстовый файл последовательного доступа n целых чисел, полученых с помощью генератора случайных чисел. Найти количество квадратов не четных чисел среди компонентов. 2) Создать очередь из n целых чисел вычисляющей по формуле A=x*x+1; x=1,2,3,..n.Найти сумму трех последних элементов очереди.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Клаткевич Денис Консантинович! Решение первой задачи с пояснениями в приложении. Приложение: uses crt; var f:text; i,a,n,k:integer; begin clrscr; assign(f,'chisla.txt'); {текстовый файл} rewrite(f); {открываем для записи} randomize; write('Vvedite razmer zapici n='); readln(n); for i:=1 to n do begin a:=random(41)+9; {должны попадать числа 9,25,49} writeln(f,a); {вводим числа последовательно в файл} end; close(f); {закрываем файл} reset(f); {открываем для чтения} k:=0; while not eof(f) do begin readln(f,a);{читаем построчно данные из файла} {если квадрат целой части корня=числу, а корень нечетное число} if (sqr(trunc(sqrt(a)))=a)and(trunc(sqrt(a))mod 2<>0) then k:=k+1; {считаем эти числа} end; writeln('K=',k); readln; close(f); end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 29.05.2008, 15:31

Вопрос № 138.412

Здраствуйте.Уважаемые эксперты.Помогите мне пожалуйста с решением задач на массивы(я в них мало понимаю),которые у меня не получаются: 1)При заданных коэффициентах A1,A2,...,An и заданном значении X вычислить значение многочлена A1X+A2X^2+...+AnX^n (2,n - степени). Указание: использовать в цикле переменную, последовательные значения которой равны X,X^2,X^3,...,X^n (2,3,n - степени). Элементы массива генерируются случайным образом в заданном диапазоне [a;b], a=-74, b=39. 2)Написать программу, которая вставляет последний элемент массива после первого отрицательного элемента этого же массива. Элементы массива генерируются случайным образом в заданном диапазоне [a;b], a=-74, b=39. Элементы массива (или массивов) выводятся в строку. При решении всех задач использовать структурированный тип - массив. 3)Найдите номера минимального и максимального элементов в массиве A(n), попавших в отрезок [x.y]. Выполнить сортировку по возрастанию элементов, расположенных между минимальным и максимальным элементами. Элементы массива генерируются случайным образом в заданном диапазоне [a;b], a=-74, b=39 и выводятся на экран. Результирующий массив выводятся в следующей строке. Исходная и результирующая матрицы сопровождается сооответствующими заголовками. Если в задаче используется двумерный массив, то исходная и результирующая матрица выводятся в виде таблиц. 4)Дана действительная матрица размера m*n, все элементы которой различны. В каждой строке выбирается элемент с наименьшим зна- чением. Затем среди этих чисел выбирается наибольшее. Указать индексы элемента с найденным значением. Элементы массива генерируются случайным образом в заданном диапазоне [a;b], a=-74, b=39 и выводятся на экран. Результирующий массив выводится в следующей строке. Если в задаче используется двумерный массив, то исходная и результирующая матрица выводятся в виде таблиц. Исходная и результирующая матрицы сопровождается сооответствующими заголовками. 5)Дана запись, в которой хранятся данные об учениках класса: фамилия, имя, отчество, адрес (улица, дом, квартира) и домашний телефон (есть он или нет). - Вывести на экран фамилию, имя и адрес тех учеников, до кого нельзя дозвониться. -Вывести и подсчитать количество всех учеников, которые имеют имя Маша. Исходные данные содержат не менее 10 записей. Данные хранятся в типизированном файле INPUT.DAT (предусмотреть возможность добавления новых записей в файл). В области модуля необходимо организовать пользовательский тип и переменную этого типа, а также соответствующие процедуры и функции для работы с записями. Результаты выводятся с соответствующими комментариями на экран и в текстовый файл OUTPUT.DAT. Спасибо за внимание!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, RustyMetal! Решение задачи 4 в приложении, приведены необходимые пояснения. Если по остальным, которые Вы почти решили, есть конкретные вопросы, задавайте на форуме или письмом. Решать их полностью совсем не хочется, т.к. один вопрос, один ответ. Пишем грамотно. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 30.05.2008, 09:09 (MCK) Приложение: Задача 4. uses crt; const n=5; m=6; var a:array[1..n,1..m]of integer; mn:set of byte; {используем множество для контроля ввода неповторяющихся чисел} i,j,min,max,jmin,imax,jmax:integer; begin clrscr; mn:=[]; {пустое множество} randomize; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin repeat a[i,j]:=random(114)-74;{интервал [-74,39]} until not (a[i,j] in mn); {повторяем, пока очередное число не будет новым} include(mn,a[i,j]); {вставляем его во множество} write(a[i,j]:4); end; writeln; end; readln; max:=-maxint; {за максимальное принимаем самое маленькое число типа Integer} for i:=1 to n do begin min:=a[i,1];jmin:=1; for j:=1 to m do if a[i,j]<min then begin min:=a[i,j]; {находим минимальные в строке} jmin:=j; {определяем номер столбца} end; if min>max then begin max:=min; {находим макс среди мин} imax:=i; {номер строки} jmax:=jmin; {номер столбца} end; end; writeln('Maximalnyj element sredi minimalnyh=',max); writeln('Raspolozen v stroke ',imax,' v stolbce ',jmax); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 08:11 Оценка за ответ: 5 Комментарий оценки: Благодарю за полный и пояснительный ответ.

Вопрос № 138.423

Уважаемые эксперты помогите сделать задачу : Напишите программу, что для каждого числа из последовательности чисел (введенных из клавиатуры) проверяла бы, является ли оно простым числом. При этом обязательно использовать рекурсивное определение натурального числа Исправлена ошибка: "натуральным" заменено на "простым" ----- ∙ Отредактировал: Denisss (Профессор) ∙ Дата редактирования: 29.05.2008, 21:20

Отправлен: 29.05.2008, 08:20 Вопрос задал: Xbondx (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Xbondx! Программа в приложении. Последовательность можно вводить до бесконечности, выход из программы происходит когда будет введен ноль. Удачи! Приложение: var a:integer; {рекурсивная функция} function Prost(b:integer):boolean; begin if b<1 then Prost:=False else if b=1 then Prost:=True else Prost:=Prost(b-1)and((a mod b)>0); end; {сама программа} begin repeat write('Enter number:'); readln(a); writeln(Prost(a-1)); until a=0; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.05.2008, 21:25 Оценка за ответ: 5 Комментарий оценки: спасибо

Отвечает: Denisss Здравствуйте, Xbondx! Пример с комментариями находится в приложении. При использовании функции (вне ее самой) следует всегда указывать второй параметр, равный 2 - этого можно избежать, но тогда усложнится код программы. Удачи! Приложение: program q138423; {Рекурсивная функция для определения простых чисел} function isSimple(const A, B: Integer): Boolean; begin { Двойка - простое число } if (A = 2) then isSimple:= True { Числа меньше двойки - не простые } else if (A < 2) then isSimple:= False { Если A делится на B без остатка, значит оно не простое } else if ((A mod B) = 0) then isSimple:= False { Финиш } else if (B > (A div B)) then isSimple:= True { Рекурсия } else isSimple:= isSimple(A, B+1); end; var a: Integer; begin repeat { Вводим число } write('A = '); readln(A); { Проверем } if isSimple(A, 2) then { Простое число } writeln('simple') else { Не простое число } writeln('not simple'); until(A <= 0); { Просим пользователя нажать любую кнопку } writeln; writeln('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 29.05.2008, 21:53 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 138.466

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

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Корчагин Петр Александрович! Программа в приложении. Использован стандартный набор генератора случайных чисел. Удачи! Приложение: const n=9; m=9; var a:array[1..n,1..m]of integer; b,c,d:integer; e:boolean; begin {создаем массив тут должно быть randomize } for b:=1 to n do begin for c:=1 to m do begin a[b,c]:=random(20); write(a[b,c]:3); end; writeln; end; {сбрасываем счетчик} d:=0; {проверяем условие} for b:=1 to m do begin e:=true; for c:=1 to n do e:=e and odd(a[c,b]); inc(d,ord(e)); end; {выводим результат} writeln('Number:',d); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.05.2008, 14:57 Оценка за ответ: 5 Комментарий оценки: Спасибо

Вопрос № 138.484

Уважаемые эксперты,помогите пожалуйста решить задачу: Вводится стола символов.Сформировать и вывести на экран новую строку,вставив после каждого 3-его символа знак @. Спасибо!:)

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Igor lukashov! Всё решается с помощью рекурсии. Т.к. длина строки постояно изменяется, знак @ вставляется с конца строки. Удачи! Приложение: var a:string; b:integer; {рекурсивная функция} function Insert_3(var s:string;c:integer):string; begin {условие рекурсии} if (c*3)<=length(s) then begin {вызываем самоу себя} Insert_3:=Insert_3(s,c+1); {вставляем символ} insert('@',s,3*c+1); end; {возвращаем строку} Insert_3:=s; end; begin {вводим строку} write('Enter string:'); readln(a); {выводим результат} write('Result:',Insert_3(a,1)); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.05.2008, 14:31 Оценка за ответ: 5 Комментарий оценки: Спасибо задача работает и выполнены все требования!)

Вопрос № 138.486

Уважаемые эксперты!Помогите пожалуйста решить следующую задачу: Вводится массив строк символов.Сформировать строку,содержащую только нечетные элементы массива,соединенные знаком "/". Спасибо:)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Igor lukashov! Как мы договорилисьна форуме, это не массив строк, а массив символов, т.е. одна строка, то так и делаем. Решение с пояснениями в приложении. Приложение: uses crt; var s,s1:string; n,i,j:integer; begin clrscr; write('Vvedite stroku: '); readln(s); writeln; s1:=''; {обнуляем новую строку} for i:=1 to length(s)-1 do {просматриваем до предпоследнего символа} if i mod 2<>0then {если номер символа нечетный} begin s1:=s1+s[i]+'/'; {переносим его в новую строку и добавляем заданный символ} end; if length(s) mod 2<>0 then {если длина строки нечетная} s1:=s1+s[length(s)]; {добавляем последний символ} writeln(s1); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 07:04 Оценка за ответ: 5

Вопрос № 138.492

здарвствуйте уважаемые эксперты, помогите пожалуйста с решением такой задачки. задан текст длиной <=250 символов. распечатать из этого текста вначале слова, заканчив. на гласную, а затем на согласную. признаком конца текста является Enter, разделителем между словами - пробел. заранее спасибо.

Отправлен: 29.05.2008, 15:11 Вопрос задал: Мусаев Руслан Ризванович (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Мусаев Руслан Ризванович! Решение Вашей задачи с комментариями в приложении. Букву "й" отнес к гласным, если нехорошо, уберите. Приложение: uses crt; const gl=['a','e','i','j','o','u','y','а','е','ё','и','й','о','у','ы','э','ю','я']; {все гласные} var s,s1,s2:string; begin clrscr; writeln('Stroka: ');readln(s); s:=s+'_ ';s1:='';s2:=''; {добавим в конец строки пробел (_)} while pos(' ',s)>0 do {пока есть пробелы} begin if s[pos(' ',s)-1] in gl then {если перед пробелом гласная} s1:=s1+copy(s,1,pos(' ',s)) {в строку 1} else if not (s[pos(' ',s)-1] in gl) {если не гласная} then s2:=s2+copy(s,1,pos(' ',s)); {в строку 2 } delete(s,1,pos(' ',s)); {удаляем слово} end; s:=s1+s2; {объединяем строки} writeln('Rezultat:'); {выводим результат} writeln(s); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 09:45

Вопрос № 138.494

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пухов Никита Евгеньевич! Решение задачи в приложении. Приложение: uses crt; function Del_3(n:longint):boolean; var u:longint; sum:byte; begin Del_3:=true; sum:=0; while n>0 do {разбиваем число на цифры, начиная с последней} begin u:=n mod 10; sum:=sum+u; {складываем их} n:=n div 10; end; if sum mod 3<>0 then Del_3:=false; end; var x:longint; begin clrscr; write('x=');;readln(x); if Del_3(x) then writeln('Cislo ',x,' delitsa na 3!') else writeln('Cislo ',x,' ne delitsa na 3!'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 08:52

Вопрос № 138.495

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пухов Никита Евгеньевич! Решение задачи в приложении. Приложение: program max_chis_bol_1_raz; uses crt; type Tmass=array[1..50]of integer; Tmatr=array [1..50] of Tmass; var mt:Tmatr; n,m,i,j,max:integer; procedure Max2(a:Tmatr;var c:integer); var b:Tmass; k,x,p:integer; begin k:=0; for i:=1 to n do begin for j:=1 to m do begin k:=k+1; b[k]:=a[i,j]; {создаем из матрицы линейный массив} end; end; for i:=1 to k-1 do for j:=1 to k-1 do if b[j]<b[j+1] then begin x:=b[j];b[j]:=b[j+1];b[j+1]:=x; {сортируем его по убыванию} end; i:=2;p:=0; while i<=k do if b[i]=b[i-1] then begin c:=b[i]; {смотрим сначала, как только одинаковые - прекращаем} p:=1; {отмечаем, что такой есть} break; end else inc(i); if p=1 then writeln('Maximalnoe chislo, >1 raza=',c) else writeln('Takogo chisla net!'); end; begin clrscr; write('Kolichestvo strok n=');readln(n); write('Kolichestvo stolbcov m=');readln(m); randomize; writeln('Matrica:'); for i:=1 to n do begin for j:=1 to m do begin mt[i,j]:=random(50); write(mt[i,j]:4); end; writeln; end; readln; Max2(mt,max); {вызов процедуры} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 09:28

Вопрос № 138.502

Уважаемые эксперты, как это реализовать??? Составить программу, формирующую одномерный массив, состоящий из N вещественных элементов. Вычислить произведение элементов массива, расположенных между максимальным и минимальным элементами. Заранее спасибо.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Корчагин Петр Александрович! Программа в приложении. Минимальный и максимальный элементы тоже умножаются. Удачи! Приложение: const n=10; var a:array[1..n]of real; b,c,d:integer; e:real; begin {создаем массив} randomize; for b:=1 to n do begin a[b]:=10*random; write(a[b]:7:3); end; writeln; {максимальный и минимальный элементы} c:=1; d:=1; for b:=2 to n do if a[c]>a[b]then c:=b else if a[d]<a[b] then d:=b; {меняем местами для цикла} if c>d then begin b:=c; c:=d; d:=b; end; {считаем произведение} e:=1; for b:=c to d do begin write(a[b]:7:3); e:=e*a[b]; end; {выводим результат} writeln('Result:',e:20:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.05.2008, 16:47 Оценка за ответ: 5 Комментарий оценки: Спасибо

Вопрос № 138.520

уважаемые эксперты, помогите решить. Составить программу, формирующую одномерный массив, состоящий из N вещественных элементов. Преобразовать массив таким образом, чтобы начала располагались все отрицательные элементы, а потом – все положительные (элементы, равные 0, считать положительными). заранее спасибо

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Корчагин Петр Александрович! Сделал с поцедурами, с сохранением порядка и без дополнительного иассива. Решение с пояснениями в приложении. Приложение: uses crt; const n=15; var a:array[1..n]of integer; i:integer; Procedure Vvod; {создание и вывод на экран массива} begin randomize; writeln('Ishodnayj massiv:'); for i:=1 to n do begin a[i]:=random(10)-3; write(a[i],' '); end; writeln; end; Procedure Perest; {перестановка элементов} var k,j,x:integer; begin k:=0; for i:=1 to n do if a[i] <0 then {если меньше ноля} begin k:=k+1; {считаем} x:=a[i]; {запоминаем число} for j:=i downto k+1 do {сдвигаем массив} begin a[j]:=a[j-1]; {на одну позицию вправо} end; a[k]:=x; {на свободное место вставляем отрицательное чимло} end; end; Procedure Vyvod; {вывод массива после перестановки} begin writeln('rezultat:'); for i:=1 to n do write(a[i],' '); readln end; begin clrscr; Vvod; Perest; Vyvod; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 12:09 Оценка за ответ: 5 Комментарий оценки: Отличное решение!

Вопрос № 138.528

Уважаемые эксперты, помогите, пожалуйста, составить программу, формирующую массив вещественных чисел и найти индекс максимального по модулю элемента массива. Заранее благодарен.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Верещагин Михаил! Программа в приложении. Удачи! Приложение: const n=10; var a:array[1..n]of integer; b,c:integer; begin {создаем массив и выводим} randomize; c:=1; for b:=1 to n do begin a[b]:=random(20)-10; write(a[b]:3); if abs(a[c])<abs(a[b])then c:=b;{ищем индекс на лету} end; writeln; {выводим результат} writeln('Index:',c:5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.530

Премногоуважаемые эксперты, помогите составить программу, формирующую массив целых чисел, найти максимальный элемент массива. Заранее спасибо.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Решение с пояснениями в приложении. Приложение: uses crt; const n=20; var a:array[1..n]of integer; i,max:integer; begin clrscr; randomize; writeln('Massiv:'); max:=-maxint; {минимальное число этого типа} for i:=1 to n do begin a[i]:=random(20); {присваиваем значение [0,19]} write(a[i],' '); {выводим на экран} if a[i]>max then max:=a[i]; {ищем максимальный} end; writeln; writeln('max=',max); {выводим на экран} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 10:35 Оценка за ответ: 5

Вопрос № 138.531

Многоуважаемые эксперты, помогите составить программу, формирующую массив целых чисел, подсчитать количество четных чисел в массиве. Заранее благодарен.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Верещагин Михаил! Программа в приложении. Удачи! Приложение: const n=15; var a:array[1..n]of integer; b,c:integer; begin randomize; c:=0; for b:=1 to n do begin a[b]:=random(200); write(a[b]:4); inc(c,ord(not odd(a[b]))); end; writeln; writeln('number:',c:5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.05.2008, 18:02 Оценка за ответ: 5

Вопрос № 138.533

Уважаемые эксперты, мне необходимо составить программу, формирующую массив целых чисел и подсчитать сумму нечетных по порядку чисел в массиве. Премного благодарен.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Верещагин Михаил! Программа в приложении. Вопросы задавайте в мини-форум. Удачи! Приложение: const n=10; var a:array[1..n]of integer; b,c:integer; begin {создаем массив и выводим} randomize; c:=0; for b:=1 to n do begin a[b]:=random(20); write(a[b]:3); inc(c,ord(odd(b))*a[b]);{суммируем на лету} end; writeln; {выводим результат} writeln('Summa:',c:5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.534

Дорогие эксперты, поспособствуйте составлению программы, формирующей целочисленную квадратную матрицу. Определить минимум среди сумм элементов диагоналей, параллельных главной диагонали матрицы. Заранее спасибо.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Решение задачи с небольшими пояснениями в приложении. Алгоритм определения следующей диагонали разберите сами на бумажке, иначе его не понять. Приложение: program matrica; uses crt; var n,i,j,l,min,sum:integer; a:array[1..20,1..20]of integer; begin clrscr; write('Vvedite razmernost matricy n=');readln(n); randomize; Writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10)-3; write(a[i,j]:4); end; writeln; end; readln; min:=maxint; {самое большое число этого типа} for l:=1 to n-1 do begin sum:=0; for i:=1 to n-1 do begin for j:=2 to n do if j=i+l then {выше диагонали} begin sum:=sum+a[i,j];{находим сумму в диагонали} end; end; if sum<min then min:=sum; {если меньше, то минимум} end; for l:=1 to n-1 do begin sum:=0; for i:=2 to n do begin for j:=1 to n-1 do if j=i-l then {ниже диагонали} begin sum:=sum+a[i,j]; end; end; if sum<min then min:=sum; end; writeln; writeln('Minimalnaja summa po diagonaliam parallelnyh glavnoj=',min); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 11:50 Оценка за ответ: 5

Вопрос № 138.536

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Решение задачи с комментариями в приложении. Приложение: uses crt; var n,i,j,k,p,m,t,g:integer; a,b:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); p:=n; {запоминаем размерность матрицы} randomize; Writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); write(a[i,j]:4); end; writeln; end; readln; b:=a; {Делаем клон матрицы} {Udalenie stroki s 0} i:=1; while i<=n do begin k:=0; for j:=1 to p do {считаем ноли в строках} if a[i,j]=0 then begin k:=k+1; end; if k>0 then {если есть} begin for t:=1 to p do for m:=i to n-1 do begin a[m,t]:=a[m+1,t]; {сдвигаем все строки до этой включительно на одну вверх} end; n:=n-1; {уменьшаем размерность массива} end else i:=i+1; {переходим к следующей строке} end; {Udalenie stolbca s 0} writeln('Rezultat:'); g:=0; {делаем счетчик столбцов с нолями} for j:=1 to p do begin k:=0; for i:=1 to p do {считаем ноли в столбцах исходной матрицы} if b[i,j]=0 then begin k:=k+1; end; if k>0 then {если есть} begin for m:=1 to n do for t:=j-g to p-1 do begin a[m,t]:=a[m,t+1]; {сдвигаем в матрице уже без нулевых строк столбцы на один влево} end; g:=g+1; {считаем такие столбцы} end end; for i:=1 to n do {выводим матрицу по условию, n меньше первоначальной на количество нулевых строк, p-g это тоже n, уменьшенное на количечтво нулевых столбцов} begin for j:=1 to p-g do write(a[i,j]:4); writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 15:27 Оценка за ответ: 5 Комментарий оценки: Спасибо за помощь! Не могли бы вы взглянуть на задачу 138779. Заранее благодарю!

Вопрос № 138.538

Многоуважаемые эксперты, помогите, пожалуйста, составить программу, формирующую целочисленную квадратную матрицу. Для заданной квадратной матрицы найти такие k, что k-я строка матрицы совпадает с k-м столбцом. Заранее благодарен.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Решение задачи в приложении. Приложение: uses crt; var n,i,j,k,p,t:integer; a:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); for i:=1 to n do for j:=1 to n do read(a[i,j]); {вводим матрицу вручную, иначе результата не будет} readln; clrscr; Writeln('Ishodnaja matrica:'); {выводим ее на экран таблицей} for i:=1 to n do begin for j:=1 to n do write(a[i,j]:3); writeln; end; readln; t:=0; for i:=1 to n do begin p:=0; for j:=1 to n do if a[i,j]=a[j,i] then {если элементы строки совпадают с элементами столбца} begin p:=p+1; {считаем их} end; if p=n then {если все совпадают} begin t:=t+1; {считаем строку} writeln('K=',i);{выводим сообщение} end; end; if t=0 then writeln('Sovpadenij net!');{если нет таких строк, сообщаем} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 08:30 Оценка за ответ: 5

Вопрос № 138.539

Уважаемые Эксперты, помогите решить задачку. Составить программу, формирующую целочисленную квадратную матрицу. Уплотнить заданную матрицу, удаляя из нее строки и столбцы, содержащие хотя бы один нулевой элемент.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Кочкарев Владислав Геннадьевич! Решение задачи с комментариями в приложении. Приложение: uses crt; var n,i,j,k,p,m,t,g:integer; a,b:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); p:=n; {запоминаем размерность матрицы} randomize; Writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); write(a[i,j]:4); end; writeln; end; readln; b:=a; {Делаем клон матрицы} {Udalenie stroki s 0} i:=1; while i<=n do begin k:=0; for j:=1 to p do {считаем ноли в строках} if a[i,j]=0 then begin k:=k+1; end; if k>0 then {если есть} begin for t:=1 to p do for m:=i to n-1 do begin a[m,t]:=a[m+1,t]; {сдвигаем все строки до этой включительно на одну вверх} end; n:=n-1; {уменьшаем размерность массива} end else i:=i+1; {переходим к следующей строке} end; {Udalenie stolbca s 0} writeln('Rezultat:'); g:=0; {делаем счетчик столбцов с нолями} for j:=1 to p do begin k:=0; for i:=1 to p do {считаем ноли в столбцах исходной матрицы} if b[i,j]=0 then begin k:=k+1; end; if k>0 then {если есть} begin for m:=1 to n do for t:=j-g to p-1 do begin a[m,t]:=a[m,t+1]; {сдвигаем в матрице уже без нулевых строк столбцы на один влево} end; g:=g+1; {считаем такие столбцы} end end; for i:=1 to n do {выводим матрицу по условию, n меньше первоначальной на количество нулевых строк, p-g это тоже n, уменьшенное на количечтво нулевых столбцов} begin for j:=1 to p-g do write(a[i,j]:4); writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 15:30 Оценка за ответ: 5

Вопрос № 138.545

Помогите пожалуйста решить задачу. Решить задачу связанную с оценкой экономической деятельностью группы предприятий на основе известных данных: 1)Название предприятий 2)Плановый объём розничного товарооборота 3)фактический объём розничного товарооборота Требуется определить: 1)процент выполненого плана каждого прдприятия 2)Количество предприятий недовыполнивших план 3)Наибольший плановый товарооборот 4)упорядочить предприятия по возростанию планового товарооборота.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, HelenaBC! Решение задачи с пояснениями в приложении. Вместо пробелов поставил подчеркивание, а то при перепечатке их не видно. Приложение: uses crt; type TPredp=record {тип запись с полями по условию} name:string; pl:word; {план} fk:word; {факт} proc:real; {процент} end; var sp:array[1..50]of TPredp; {массив записей-список предприятий} n,i,j,k,max:word; {разные переменные} bf:TPredp; {буфер при сортировке} begin clrscr; write('Vvedite kolichestvo predprijatij n='); readln(n); for i:=1 to n do {заполняем список} begin writeln('Predprijatie_',i); write('Nazvanie:_');readln(sp[i].name); write('Plan_');readln(sp[i].fk); sp[i].proc:=sp[i].fk/sp[i].pl*100; end; clrscr; writeln('Procent vypolnenja plana:'); for i:=1 to n do writeln(sp[i].name,sp[i].proc:6:1,'%'); writeln; k:=0; for i:=1 to n do if sp[i].fk<sp[i].pl then begin k:=k+1; end; writeln('Ne vypolnili plan_',k,'_predprijat'); writeln; max:=sp[1].pl; for i:=2 to n do if sp[i].pl>max then max:=sp[i].pl; writeln('Naibolshij plan=',max); writeln; for i:=1 to n-1 do {сортировка по возрастанию пузырьком} for j:=1 to n-i do if sp[j].pl>sp[j+1].pl then {по полю план} begin bf:=sp[j]; sp[j]:=sp[j+1]; {сортируем все записи полностью} sp[j+1]:=bf; end; writeln('Spisok predprijatij po vozrastaniu plana:'); writeln; for i:=1 to n do writeln(sp[i].name,'__Plan_',sp[i].pl,'__Fakt_',sp[i].fk,'__Procent',sp[i].proc:6:1); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 15:46 Оценка за ответ: 4 Комментарий оценки: Cпасибо за ответ, но в коде есть некоторая не точность

Вопрос № 138.554

написать программу которая методом обмена сортирует по возрастанию введённый с клавиатуры одномерный массив размерностью N

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Степанов Александ Сергеевич! Сортировку обменом введенных с клавиатуры вещественных чисел смотрите в приложении. Во время работы программы подсвечиваются элементы массива которые обмениваются. Это позволяет понять, почему этот метод называют методом "пузырька". Удачи! Приложение: uses crt; const n=9; type mass=array[1..n]of real; var a:mass; i:integer; {процедура будет вызыватся рекурсивно} procedure Sort(var aa:mass); var x:integer; j:real; begin {запускаем цикл проверки} for x:=1 to n-1 do if aa[x]>aa[x+1] then begin {обмениваем соседние элементы массива} j:=aa[x]; aa[x]:=aa[x+1]; aa[x+1]:=j; {вывод для контроля} for i:=1to n do begin {только для подсветки перестановок} if (i=x)or(i=(x+1)) then TextColor(15); write(aa[i]:8:4); TextColor(7); end; writeln; {вызываем саму себя с новым расположением элементов массива} Sort(aa); end; {сортировка закончилась} end; begin randomize; for i:=1 to n do begin {ввод массива} write('Enter a[',i,']:='); readln(a[i]); end; writeln; writeln; {сортируем массив} Sort(a); writeln; {выводим результат сортировки массива} for i:=1 to n do write(a[i]:8:4); writeln; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.555

навписать процедуру для ввода элементов одномерного массива MAS размерностью N. Дан одномерный массив состоящий из N элементов найти сумму отрицательных элементов данного массива.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Степанов Александ Сергеевич! Решение задачи с пояснениями в приложении. Приложение: uses crt; const n=15; type Tmass=array[1..n]of integer; var a:Tmass;j,sum:integer; procedure Vvod(var ms:Tmass);{процедура ввода массива} var i:integer; begin writeln('Vvedite ',n,' chisel'); for i:=1 to n do readln(a[i]); {вводим числа столбиком} clrscr; {очищаем экран} writeln('Massiv:'); for i:=1 to n do write(a[i],' '); {выводим массив в строчку} writeln; end; begin clrscr; Vvod(a); {вызываем процедуру} sum:=0; for j:=1 to n do if a[j]<0 then {считаем сумму отрицательных} sum:=sum+a[j]; writeln('Summa otricatelnyh chisel=',sum); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 16:28

Вопрос № 138.556

Написать процедуру для вода элементов двумерного массива MAS размерностью N x M.

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

Отвечает: Костя Симанович Здравствуйте, Степанов Александ Сергеевич! Решение в приложении. Обратите внимание на описание процедуры ввода массива, т.к мы должны передать заполненный массив обратно в программу то добавляем слово var перед описанием массива. Для примера ниже я написал процедуру вывода, здесь наоборот данные передаются в процедуру, а обратно нам ничего получать не надо. Удачи. Приложение: program wwod_wiwod; const m = 4; n = 3; type mass = array[1..m, 1..n] of real; procedure wwod(var x:mass); {процедура ввода} var i, j : integer; begin for i := 1 to m do for j := 1 to n do begin writeln('Введите элемент под № ', i, ' ',j); readln(x[i,j]); end; end; {для проверки выводим что получилось} procedure wiwod(x:mass); var i, j : integer; begin for i := 1 to m do begin for j := 1 to n do begin write(x[i, j]:3:1, ' '); end; writeln; end; end; {основная программа} var a : mass; begin wwod(a); wiwod(a); readln; end.

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

Вопрос № 138.558

Написать процедуру для вывода на экран двумерного массива размерностью 3 x 3 в виде матрицы.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Степанов Александ Сергеевич! Решение с пояснениями в приложении. Приложение: uses crt; const n=3; type Tmatr=array[1..n,1..n]of integer;{тип матрицы} var i,j:integer; a:Tmatr; Procedure Vvod(var mt:Tmatr);{процедура ввода} begin writeln('Vvedite ',n*n,' chisel'); for i:=1 to n do for j:=1 to n do readln(mt[i,j]); {вводим столбиком числа} clrscr; {очищаем экран} writeln('Matrica:'); {выводим матрицу в виде таблицы} for i:=1 to n do begin for j:=1 to n do write(mt[i,j]:4); writeln; end; end; begin {начало программы} clrscr; Vvod(a); {вызов процедуры} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 16:50

Вопрос № 138.559

Написать программу, которая проверяет, находится ли в двумерном массиве A размерностью 3 x 4 введённое с клавиатуры число B.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Степанов Александ Сергеевич! Задача в приложении. Для того чтобы мы знали есть ли в массиве введенное число, объявим логическую переменную InArray: var  InArray: boolean В начале программы присвоим переменной false, то есть в массиве нет такого числа, потом массив заполняется случайными числами с помощью random. Перед использованием этой функции, надо включить генератор случайных чисел с помощью randomize. Random(n) возвращает случайное число из диапазона от 0 до n-1. Во время заполнения массива сразу же проверяем, равен ли только что заполненный элемент введенному числу. Если да, то приравниваем InArray к true. После заполнения мы проверяем переменную InArray, если она равна true, то выводим "Есть", иначе "Нет". Удачи!!! Отредактировано по просьбе эксперта. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 29.05.2008, 22:34 (MCK) Приложение: var {Массив} a: array [1..3, 1..4] of integer; {Переменная по которой определяем есть ли число в массиве} InArray: boolean; {b-введенное число, i,j-для For} b, i, j: integer; begin {Получаем число} Write('Введите число: '); ReadLn(b); {Вклюаем генератор случайных чисел} randomize; {Сначало числа в массиве нет} Inarray:=false; {Заполняем массив сл. числами из диапозона [0;11]} WriteLn('Массив: '); for i:=1 to 3 do begin for j:=1 to 4 do begin a[i, j]:=random(12); Write(a[i, j]:4); {Если число равно введенному, то присваиваем InArray true} if a[i, j] = b then InArray:=true; end; writeln; end; {Если есть, то выводи "Есть", иначе "Нет"} if InArray then write('Есть') else Write('Нет'); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 29.05.2008, 22:25

Вопрос № 138.560

Дан двумерный массив размерностью N x M, найи минимальный и максимальный элементы каждой строки данного массива.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Степанов Александ Сергеевич! Решение в приложении. Приложение: uses crt; var a:array[1..20,1..20]of integer; n,m,i,j,max,min:integer; begin clrscr; write('Kolichestvo strok= ');readln(m); write('Kolichestvo stolbcov= ');readln(n); randomize; Writeln('Matrica:'); {создание и вывод исходной матрицы} for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(21)-10; write(a[i,j]:4); end; writeln; end; readln; for i:=1 to m do {поиск макс и мин в строках} begin max:=a[i,1];min:=a[i,1]; for j:=1 to n do begin if a[i,j]>max then begin max:=a[i,j]; end else if a[i,j]<min then begin min:=a[i,j]; end; end; writeln('V stroke ',i,' max=',max,' mim=',min); end; writeln; for j:=1 to n do {поис макс и мин в столбцах} begin max:=a[1,j];min:=a[1,j]; for i:=1 to m do begin if a[i,j]>max then begin max:=a[i,j]; end else if a[i,j]<min then begin min:=a[i,j]; end; end; writeln('V stolbce ',j,' max=',max,' mim=',min); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 17:51

Вопрос № 138.564

написать процедуру для вывода на экран двумерного массива размерностью N x M в виде матрицы.

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

Отвечает: Gh0stik Здравствуйте, Степанов Александ Сергеевич! Вот, пожалуйста, изучайте процедуру вывода - годится для любого двумерного массива чисел. const n=4; m=3; type mas=array [1..n,1..m] of real; procedure outMas(x:mas); {процедура вывода} var i,j:integer; begin   for i:=1 to n do begin     for j:=1 to m do write(x[i,j]:6:1);     writeln;   end; end; {*** Основная программа ***} var a:mas; begin   outMas(a); {вызов процедуры}   readln; end. Good Luck! --------- Непечатный жаргон - это тот язык, которым решительно все программисты владеют в совершенстве.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 29.05.2008, 21:41

Вопрос № 138.565

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Степанов Александ Сергеевич! Решение в приложении. Приложение: uses crt; var a:array[1..20,1..20]of integer; n,i,j,sumGl,sumPb,sumDg:integer; begin clrscr; write('Vvedite razmernost matricy= ');readln(n); randomize; Writeln('Matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(21)-10; write(a[i,j]:4); end; writeln; end; readln; sumGl:=0;sumPb:=0; for i:=1 to n do begin sumGl:=sumGl+a[i,i]; {сумма на главной диагонали} sumPb:=sumPb+a[i,n-i+1]; {сумма на побочной диагонали} end; writeln; writeln('Summa na glavnoj diagonali=',sumGl); writeln('Summa na pobochnoj diagonali=',sumPb); if n mod 2=0 then sumDg:=sumGl+sumPb {общая сумма в четной матрице} else if n mod 2<>0 then sumDg:=sumGl+sumPb-a[n div 2+1,n div 2+1]; {общая сумма в нечетной матрице} writeln('Summa na obeih diagonaljah=',sumDg); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 18:16

Вопрос № 138.566

написать функцию нахождения суммы элементов двумерного массива размерностю N x M.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Степанов Александ Сергеевич! Функция с программой использующей её и с пояснениями в приложении. SumArray-функция подсчета суммы. Удачи!!! Приложение: const {Кол-во строк} N=5; {Кол-во столбцов} M=10; type {создаем тип массива} MyArray = array [1..N, 1..M] of integer; var {Двумерный массив} a: MyArray; {Для For} i, j:integer; {функция, единственный параметр-переменная массив типа MyArray, возвращает сумму} function SumArray(a: MyArray): integer; var {i,j-для for, sum-сумма} i, j, sum: integer; begin {Обнуляем сумму} Sum:=0; for i:=1 to N do for j:=1 to M do {В цикле проходим весь массив и вычисляем сумму} inc(sum, a[i, j]); {Возвращаем результат} SumArray:=Sum; end; begin {Заполняем массив сл. числами и выводим его} randomize; for i:=1 to N do begin for j:=1 to M do begin a[i, j]:=random(100); Write(a[i, j]:3); end; writeln; end; {Выводим сумму} Write('Сумма: ', SumArray(a)); readln end.

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

Вопрос № 138.567

написать процедуру для ввода с клавиатуры двумерного массива размерностю N x M.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Степанов Александ Сергеевич! Процедура ввода, вывода и программа использующая их в приложении. InPutArray-ввод OutPutArray-вывод Удачи!!! Приложение: const {Кол-во строк} N=3; {кол-во столбцов} M=5; type {Создаем тип двумерного массива} MyArray = array [1..N, 1..M] of integer; var {Массив} a: MyArray; {Процедура ввода массива с клавиатуры var перед параметром означает то, что результат вернется в переменную указанную в первом параметре} procedure InPutArray(var a: Myarray); var {Для For} j, i: integer; begin {Перебираем весь массив} for i:=1 to N do for j:=1 to M do begin {Получаем и сохранаем число в тек. элю массива} write('Введите [', i, ';', j, ']: '); readln(a[i, j]); end; end; {Выводит массив} procedure OutPutArray(a: MyArray); var j, i: integer; begin for i:=1 to N do begin for j:=1 to M do write(a[i, j]:6); writeln; end; end; begin Writeln('Ввод массива.'); InPutArray(a); WriteLn('Проверка.'); OutPutArray(a); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 29.05.2008, 21:46

Вопрос № 138.575

Уважаемые эксперты, помогите, пожалуйста разобраться в решении задачи(моё решение в приложении, но оно не выдаёт нужного результата, хотелось бы узнать, в чём ошибка): 1. Дан массив данных об автомобилях заводского гаража (Формирование массива из файла и таким образом, чтобы в каждой строчке была вся информация по конкретному автомобилю): номер, марка, год выпуска, пробег, фамилия шофёра. Вывести: - сообщение о том, есть ли в гараже автомобиль заданной марки (да или нет) (с помощью цикла While); - список машин, подготовленных на списание (старше 1980 года с пробегом более 50 000км), в списке указаны все данные, кроме фамилии шофёра; -все записи, упорядоченные по признаку: фамилии шофёров в алфавитном порядке. Приложение: Вот что выходит в результате: Input cars mark:Lexus No... Input spisok cars k spisaniyu: Spisok po drivers surname: Surname1007 Toyota 1988 400NumberMarkaYear of vipusk0Probeg0 Surname1008 Hummer 2007 500NumberMarkaYear of vipusk0Probeg0 Surname1009 VAZ 1989 37000NumberMarkaYear of vipusk0Probeg0 Surname1010 Mazda 2001 2300NumberMarkaYear of vipusk0Probeg0 Это мой текстовый файл: 1001 Honda 1999 34000 Ivanov 1002 Pobeda 1975 75000 Petrov 1003 BMW 2000 20000 Krasnov 1004 Volga 1960 55000 Sidorov 1005 Niva 1978 60000 Dubov 1006 Lexus 2002 10000 Rublev 1007 Toyota 1988 40000 Vavilov 1008 Hummer 2007 5000 Kabanov 1009 VAZ 1989 37000 Popov 1010 Mazda 2001 23000 Galenko А вот решение: program cars; uses SysUtils; Const q=5; Type Garag=record numb:string[20]; mark:string[20]; year:word; prb:longint; surn:string[20]; end; Var sp:array[1..q] of Garag; n,c,k,i,j:integer; s,m:string; buf:Garag; f:text; god:word; pr:longint; BEGIN Assign (f,'d:Spisok.txt'); ReSet(f); n:=0; While not EOF(f) do begin readln(f,s); inc(n); sp[n].numb:=copy(s,1,pos('',s)-1); delete(s,1,pos('',s)); sp[n].mark:=copy(s,1,pos('',s)-1); delete(s,1,pos('',s)); val(copy(s,1,pos('',s)-1),god,c); sp[n].year:=god; delete(s,1,pos('',s)); val(copy(s,1,pos('',s)-1),pr,c); sp[n].prb:=pr; delete(s,1,pos('',s)); sp[n].surn:=s; end; writeln; write('Input cars mark:'); readln(m); k:=0; For i:=1 to n do if sp[i].mark=m then inc(k); if k>0 then writeln('Yes!') else writeln('No...'); writeln; Writeln('Input spisok cars k spisaniyu:'); For i:=1 to n do If (sp[i].year<1980) and (sp[i].prb>50000) then begin write('Number',sp[i].numb,'Marka',sp[i].mark); write('Year of vipusk',sp[i].year,'Probeg',sp[i].prb); writeln; end; writeln; writeln('Spisok po drivers surname:'); For i:=1 to n-1 do For j:=1 to n-1 do if sp[j].surn>sp[j+1].surn then begin buf:=sp[j]; sp[j]:=sp[j+1]; sp[j+1]:=buf; end; For i:=1 to n do begin write('Surname',sp[i].surn,'Number',sp[i].numb,'Marka',sp[i].mark); write('Year of vipusk',sp[i].year,'Probeg',sp[i].prb); writeln; end; readln; END.

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

Отвечает: Disasm Здравствуйте, Ласточка! 1. При считывании из файла записей, в цикле "While not EOF(F) do" в функциях Pos() первым аргументом стоят кавычки без пробела. Соответственно операции со строками не работают. 2. В начале задаете константу q=5 для массива записей sp, а из файла считываете уже 10 записей. Следует константу увеличить хотя бы до 100. 3. Цикл for переделал на While, смотрите приложение. 4. Следует при выводе текстовых сообщений разбавить их пробелами, для удобочитаемости. Приложение: write('Input cars mark:'); readln(m); k:=0; i:=0; while i<n do begin inc(i); if sp[i].mark=m then inc(k); end; if k>0 then writeln('Yes!') else writeln('No...');

Ответ отправил: Disasm (статус: 2-ой класс) Ответ отправлен: 30.05.2008, 15:27

Вопрос № 138.577

Доброго времени суток уважаемые эксперты. Есть несколько вопросов по задачам 1) Организовать массив записей, который содержит справочную информацию о внутренних телефонных номерах предприятия (номер телефона, номер помещения, фамилия ответственного лица). Составить программу, которая по фамилии выдает номер телефона телефона и номер помещения. проблема: Решил, проверьте на наличие ошибок или неточностей (преподаватель очень придиристый). 2) Имеется текстовый файл. Напечатать его первые 6 строк. Проблема: Как я понял задачу, так и решил. Правильно? и можно ли как нить "укоротить" Приложение: 1) uses crt; type mas=record tel:integer; pom:integer; fam:string[10]; end; var a:array[1..100] of mas; i,n:integer; st:string; begin clrscr; write('Vvedite kolichestvo nomerov: ');readln(n); for i:=1 to n do begin writeln('Nomer: ',i); write('Nomer telefona: ');readln(a[i].tel); write('Nomer pomeshenia: ');readln(a[i].pom); write('Familia: ');readln(a[i].fam); end; write('Vvedite familyu: ');readln(st); writeln('INFO:'); for i:=1 to n do if st=a[i].fam then writeln('Nomer telefona: ',a[i].tel,' Nomer pomeshenia: ',a[i].pom); repeat until keypressed; end. 2) uses crt; var f:file of integer; i,z:integer; a:array[1..100] of integer; begin clrscr; randomize; assign(f,'1.dat'); rewrite(f); for i:=1 to 20 do begin a[i]:=random(100); write(f,a[i]); end; close(f); reset(f); while not eof(f) do begin read(f,a[i]); write(a[i]:2,' '); end; writeln; reset(f); writeln; for i:=1 to 6 do begin read(f,a[i]); write(a[i]:2,' '); end; close(f); repeat until keypressed; end.

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

Отвечает: S K A L T Здравствуйте, DaImeR! Первая задача проще некуда! Думаю укорачивать её нет необходимости да и этого и не сделаешь. как я понял вторую задачу то здесь нужен двумерный массив и печатать нужно только первые 6 строк. А вы, как я считаю, печатаете первые 6 столбцов. И второе если уж очень придиристый учитель то перед reset(f) отключется автоматическая проверка ошибок и затем включается обратно: Приложение: {$I-} reset(f) {$I+}

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 30.05.2008, 21:16

Отвечает: Пупорев Юрий Борисович Здравствуйте, DaImeR! По первой задаче. Почти все работает корректно, только нужно изменить тип у номера телефона на string[20], потому, что это не число а набор символов, который можно написать типа 25-65-38, внутренние тоже часто пишут 2-54 и т.д. и у Вас программа не заработает. Кроме того тип integer явно не потянет для сотовых телефонов. Фамилия тоже 10 знаков мало, бывают фамилии длиннее, тоже string[20]. По второй задаче в условии ясно сказано, что ИМЕЕТСЯ ТЕКСТОВЫЙ ФАЙЛ, а вы зачем-то создаете типизированный. Создайте текстовый файл, заполните его в несколько(больше 6)строк цифрами и латиницей, сохраните как 1. Код я переделал, действительно Вы перестарались. При чтении файла просто считаете строки. Как только их будет 6 чтение файла закончится. Код второй задачи в приложении. Приложение: uses crt; var f:text; i:integer; a:string; begin clrscr; assign(f,'1.txt'); reset(f); i:=1; while not eof(f)and(i<=6) do begin readln(f,a); writeln(a); i:=i+1; end; readln; close(f); end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 30.05.2008, 21:23

Вопрос № 138.582

Здраствуйте уважаемые эксперты. Очень нужна ваша помощь. Нужно решить две задачи. Задача 1 Построить семейство графиков cos nx где n вводит пользователь. Задача 2 Сформировать двумерный массив где найти минимальный элемент в каждом столбце. Заранее огромное спасибо!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Marina korolyova! Решение в приложении. Пояснения минимальны, т.к. просто нечего объяснять. Приложение: uses crt; var a:array[1..20,1..20]of integer; n,m,i,j,min:integer; begin clrscr; write('Kolichestvo strok= ');readln(n); write('Kolichestvo stolbcov= ');readln(m); randomize; Writeln('Matrica:'); {создаем матрицу} for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(21)-10; write(a[i,j]:4); end; writeln; end; readln; for j:=1 to m do begin min:=a[1,j]; {за мин примем первый элемент столбца} for i:=1 to n do begin if a[i,j]<min then begin min:=a[i,j]; {находим мин в столбце} end; end; writeln('min elem v stolbce ',j,'=',min:3); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 19:47

Вопрос № 138.629

Уважаемые эксперты, помогите решить: Составить программу, формирующую целочисленную прямоугольную матрицу. Определить сумму элементов в тех строках, которые содержат хотя бы один отрицательный элемент. Заранее спасибо

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Корчагин Петр Александрович! Решение задачи с пояснениями в приложении. Приложение: uses crt; const n=6;m=7; var a:array[1..n,1..m]of integer; sum,k:integer; i,j:byte; begin clrscr; randomize; writeln('Matrix'); for i:=1 to n do {создаем матрицу} begin for j:=1 to m do begin a[i,j]:=random(11)-2; {заполняем сдучайными числами из диапазона [-2,10]} write(a[i,j]:5); end; writeln; end; for i:=1 to n do begin k:=0;sum:=0; for j:=1 to m do if a[i,j]<0 then {если числа <0} begin inc(k); {считаем их} sum:=sum+a[i,j]; {считаем сумму} end; {Если есть хоть одно отрицательное число, выводим сумму в строке} if k>0 then writeln('Summa v stroke ',i, '=',sum); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 20:23 Оценка за ответ: 5

Вопрос № 138.638

После выполнения части программы в графическом режиме перехожу обратно в тестовую, но перестают корректно отображаться символы русских букв. Вроде бы как можно решить эту проблему с помощью запуска программы keyrus.exe. Нашел в справке, что программы запускаются с помощью команды exec(), но осуществить это не получается. Компилятор требует к пути какие-то параметры. Подскажите где их брать или другой способ вернуть русским буквам нормальный вид.

Отправлен: 30.05.2008, 11:20 Вопрос задал: Жиляев М. Ю. (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: S K A L T Здравствуйте, Жиляев М. Ю.! У меня тоже была похожая проблема. Советую скачать в нете другой турбо паскаль. Но есть проблема. Если скачать с сайта то в большинстве случаев не будет работать Graph.tpu. Оставьте только его, а все остальные замените скачанными файлами. P.S. могу скчать вам если не обходимо......

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 30.05.2008, 20:55

Вопрос № 138.645

Уважаемые эксперты, как составить программу, формирующую одномерный массив, состоящий из N целых элементов? Сжать массив, удалив из него все элементы, модуль которых не превышает 1. Освободившиеся в конце массива элементы заполнить нулями. Заранее благодарен.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Я так понял, что "модуль которых не превышает 1." это ноль, -1 и 1. Решение задачи в приложении. Приложение: uses crt; const n=15; var a:array[1..n]of integer; i,j,p:integer; begin clrscr; randomize; writeln('Ishodnyj massiv:'); {формируем массив из 15 элементов, случайные числа из инт.[-4,5]} for i:=1 to n do begin a[i]:=random(10)-4; write(a[i],' '); {выводим его на экран} end; writeln; i:=2;p:=n; {начинаем со второго элемента, запоминаем размер массива} while i<=p do {пока индекс не превышает длину массива} begin if abs(a[i])<=1 then {если модуль элемента <=1, т.е a[i]=-1,0,1} begin for j:=i to p-1 do {от этого элемента до предпоследнего} begin a[j]:=a[j+1]; {сдвигаем все на 1 позицию влево(удаляем a[i])} end; p:=p-1; {уменьшаем размер массива} end else i:=i+1; {если нет, переходим к следующему элементу} end; writeln('Rezultat:'); for i:=1 to p do {выводим остатки массива} write(a[i],' '); for i:=p+1 to n do {дополняем его нолями (_ это пробел)} write('0_'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 09:40 Оценка за ответ: 5

Вопрос № 138.653

Добрый день, Уважаемые эксперты. Помогите решить задачку. Составить программу, формирующую целочисленную квадратную матрицу. В матрице найти номер первой из строк, содержащей только положительные элементы. Заранее благодарю

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Корчагин Петр Александрович! Решение с пояснениями в приложении. Приложение: uses crt; var n,i,j,k,p:integer; a:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); randomize; Writeln('Ishodnaja matrica:'); {создаем и выводим на экран матрицу} for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10)-1; {случайные числа диапазон [-1,9]} write(a[i,j]:4); end; writeln; end; readln; p:=0; for i:=1 to n do begin k:=0; for j:=1 to n do if a[i,j]>0 then {если положительное} begin k:=k+1; {считаем} end; if k=n then {если все положительные в строке} begin writeln('Pervaja stroka=',i);{выводим номер первой такой строки} readln; exit; {заканчиваем программу} end else p:=p+1; {считаем негодные строки} end; if p=n then writeln('Takih strok net!');{если все, сообщаем} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 21:03 Оценка за ответ: 5 Комментарий оценки: Спасибо

Вопрос № 138.679

Добрый день, Уважаемые эксперты. Помогите разобраться. Составить программу, формирующую целочисленную квадратную матрицу. Для заданной квадратной матрицы найти такие k, что k-я строка матрицы совпадает с k-м столбцом. Я написал что-то, но оно не работает. P.S. см. приложение. Заранее спасибо за помощь Приложение: const M = 3; var a:array[1..m,1..m] of integer; x, y, k, j: integer; BEGIN begin for x:=1 to m do for y:=1 to m do begin writeln('vvedite element massiva',x,y); readln(a[x,y]); end; end; begin for x:=1 to m do begin for y:=1 to m do write(a[x,y],' ') ; writeln; end; end; for k:=1 to m do begin j:=1; while (j<=m) and (A[k,j]=A[j,k]) do Inc(j); if (j>m) then Writeln(' k= ', k); end; readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Корчагин Петр Александрович! Решение задачи в приложении. Приложение: uses crt; var n,i,j,k,p,t:integer; a:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); for i:=1 to n do for j:=1 to n do read(a[i,j]); {вводим матрицу вручную, иначе результата не будет} readln; clrscr; Writeln('Ishodnaja matrica:'); {выводим ее на экран таблицей} for i:=1 to n do begin for j:=1 to n do write(a[i,j]:3); writeln; end; readln; t:=0; for i:=1 to n do begin p:=0; for j:=1 to n do if a[i,j]=a[j,i] then {если элементы строки совпадают с элементами столбца} begin p:=p+1; {считаем их} end; if p=n then {если все совпадают} begin t:=t+1; {считаем строку} writeln('K=',i);{выводим сообщение} end; end; if t=0 then writeln('Sovpadenij net!');{если нет таких строк, сообщаем} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 08:34

Вопрос № 138.684

Уважаемые эксперты!помогите пожалуйста решить следующую задачу: Выполните обработку элементов прямоугольной матрицы А,имеющей N строк и М столбцов.Исключить из матрицы столбец с номером L.Сомкнуть столбцы матрицы. Спасибо!)

Отправлен: 30.05.2008, 14:42 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Igor lukashov! Решение задачи в приложении. Приложение: uses crt; var n,m,i,j:integer; L:integer; a:array[1..50,1..50]of integer; begin clrscr; write('n=');readln(n); write('m=');readln(m); repeat {цикл проверки правильного ввода L} write('vvedite L<=m: '); readln(L); if (L<1)or(L>m)then writeln('Nedopustimoe znachenie, povtorite!'); until (L>=1)and(L<=m); randomize; writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); write(a[i,j]:3); end; writeln; end; readln; {Udalenie stoldca} for i:=1 to n do for j:=L to m-1 do begin a[i,j]:=a[i,j+1]; {сдвигаем все столбцы влево до L} end; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to m-1 do write(a[i,j]:3); writeln; end; readln; end. end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 21:55 Оценка за ответ: 5

Вопрос № 138.687

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

Отправлен: 30.05.2008, 14:49 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Igor lukashov! Решение задачи в приложении. Приложение: uses crt; var s:array[1..50]of string; st:string; i,m,k,j:integer; begin clrscr; write('m=');readln(m); for i:=1 to m do begin readln(s[i]); {вводим слова} end; writeln; writeln('Palindromy:'); st:=''; k:=0; for i:=1 to m do begin {если слово с конца читается также, как и с начала - перевертыш} for j:=length(s[i])downto 1 do st:=st+s[i][j]; if st=s[i] then begin k:=k+1; {считаем} writeln(st);{выводим} end; st:=''; {обнуляем строку - буфер} end; if k=0 then writeln('Takih slov net!');{если нет сообщаем} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 08:41 Оценка за ответ: 5

Вопрос № 138.688

Уважаемые эксперты!Помрогите пожалуйста решить следующее: Определить процент положительных и отрицательных чисел. При вводе числа -65432 закнчить работу. Спасибо большое!)

Отправлен: 30.05.2008, 14:51 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Igor lukashov! Программа в приложении. Наверное вместо числа -65432, лучше использовать ноль, т.к. он не пренадлежить ни положительным ни отрицательным, а используемое число отрицательное. Ввод нуля счетчики не изменяет. Удачи! Приложение: var a:longint; z:array[false..true]of integer; begin {сбрасываем счеттчик} z[false]:=0; z[true ]:=0; repeat {вводим число} write('Enter number:'); readln(a); {проверяем условие, по результатам сравнения увеличится нужный счетчик} inc(z[a>0],ord(a<>0)); until a=-65432; {получаем общее число чисел} a:=z[false]+z[true]; {выводим результат} writeln('minus:',100*z[false]/a:10:0,'plus:':10,100*z[true]/a:10:0); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.748

Тема: обработка последовательностей символов.( тип String) В строке S , содержащей n символов, есть по крайней мере одна запятая. Поменять меставми симповлы,стоящие до и после запятой.

Отправлен: 30.05.2008, 22:40 Вопрос задала: Иванова Дарья Сергеевна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванова Дарья Сергеевна! В приложении программа, которая все это делает. Удачи! Приложение: var a,b:string; begin {вводим строку, пока не будет запятой} repeat write('Enter string:'); readln(a); until pos(',',a)>0; {работа со строковыми подпрограммами} b:=copy(a,1,pos(',',a)-1);{копируем до запятой} delete(a,1,pos(',',a));{удаляем скопированное и запятую} writeln('result:',a,',',b);{выводим результат} end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.767

Здравствуйте эксперты. "А" квадратная матрица. Найти сумму элементов таких что "i" нечетные, а "j" простое число.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Корчагин Петр Александрович! Код с пояснениями в приложении. Удачи!!! Приложение: const {Размер матрицы} N=5; var {i, j-счетчики для For} i, j: integer; {Сумма} sum: integer; {Матрица} A: array [1..N, 1..N] of integer; {Проверяет, является ли число простым числом} function is_simple(p:integer):boolean; var i : integer; res : boolean; begin i := 2; res := true; while res and (i < p) do begin res := p mod i <> 0; inc(i); end; is_simple := res; end; begin {Обнуляем сумму} sum:=0; {Включаем генератор сл. чисел} randomize; {в цикле заполняем массив сл. числами} for i:=1 to N do begin for j:=1 to N do begin a[i, j]:=random(100); write(a[i, j]:4); {Если i-нечетное и j - простое, то прибавляем число к сумме} if Odd(i) and Is_simple(j) then inc(sum, a[i, j]); end; WriteLn; end; {Вывод} Write('Сумма: ', sum); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 31.05.2008, 16:50 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 138.773

Уважаемые Эксперты, помогите: как в процедуру передавать двумерный массив?

Отправлен: 31.05.2008, 11:02 Вопрос задал: Nacho (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Устинов С.Е. Здравствуйте, Nacho! Напрямую двумерный массив передавать не получится, но Вы можете создать новый тип переменных - двумерный массив и уже переменную этого типа передавать. Покажу на примере: type MyArray=array[1..100, 1..200] of integer; var Ar: MyArray; Дальше с переменной Ar Вы можете работать как с обычным двумерным массивом, кроме того появилась возможность передавать его как параметр для функции или процедуры: procedure work(Z:MyArray); Пример использования - в приложении. Удачи! Приложение: program Project1; {$APPTYPE CONSOLE} uses SysUtils; type MyArray=array[1..100, 1..200] of integer; var Ar: MyArray; procedure work(var Z:MyArray); begin Z[1,1]:=123; end; begin work(Ar); writeln(Ar[1,1]); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Профессионал) Украина, Славянск Организация: SlavComp WWW: Физико-математический факультет СГПУ ICQ: 4343069 ---- Ответ отправлен: 31.05.2008, 11:20

Отвечает: Coupler Здравствуйте, Nacho! C учетом дополнения в минифоруме - можно использовать динамические массивы (смотря в чем пишете, например в Turbo Pascal их нет, во Free Pascal и Delphi есть). При их использовании учитывайте, что нумерация в них с 0. Пример в приложении. Приложение: program Project2; type TMatrix = array of array of integer; procedure outmatrix(var a: TMatrix; n, m: integer); var i, j: integer; begin for i := 0 to n - 1 do begin for j := 0 to m - 1 do write(a[i][j], ' '); writeln; end; end; var matr1, matr2: TMatrix; i, j, n, m: integer; begin n := 2; m := 3; randomize; setlength(matr1, m); for i := 0 to m - 1 do setlength(matr1[i], n); for i := 0 to n - 1 do begin for j := 0 to m - 1 do matr1[i][j] := random(20); end; outmatrix(matr1, n, m); writeln; n := 3; m := 4; randomize; setlength(matr2, m); for i := 0 to m - 1 do setlength(matr2[i], n); for i := 0 to n - 1 do begin for j := 0 to m - 1 do matr2[i][j] := random(20); end; outmatrix(matr2, n, m); readln; end.

Ответ отправил: Coupler (статус: Специалист) Ответ отправлен: 31.05.2008, 17:35

Отвечает: Зенченко Константин Николаевич Здравствуйте, Nacho! Двумерный массив в памяти компьютера хранится в таком виде: а11,а12,. . .,а1n,a21,a22,. . .,a2n и т.д. Другими словами, это последовательность байт(слов) с адресом указывающим на элемент а11 и количеством элементов N * M. Все элементы считаются как смещение от начала этого массива(I * N + J)* длина одного элемента массива. При компиляции программы, именно адрес первого элемента передается в подпрограммы(процедуры и функции). В Turbo Pascal есть стандарные средства, которые позволяют реализовать Вашу задачу. 1)Предопределенный тип Pointer обозначает нетипизированный указатель (указатель который не указывает на какой-либо определенный тип). 2)Указательные типы на переменые опрeделенного типа, к примеру такая запись : IntPtr=^Integer; будет указывать на переменную типа Integer длиной два байта. 3)Стадартные опрераторы, процедуры и функции для работы с указательными типами, с помощью которых Вы можете присвоить значение указательной переменной: - процедур New или GetMem; - оператора @ или функции Аddr; - функции Ptr. Все это показано в приведенной программе. В функцию АА передается указатель на массив опредеделеного пользователем типа, но в самой функцие этот указатель принимается как нетипизированный, т.е. не привязанный к конкретному типу. В функции PTR этот указатель пересчитывается как указатель на целый тип, т.е. значение считанное или записанное с его помощью имеет длину два байта. Удачи! Приложение: const n=5; m=6; type TMasA=array[1..n,1..n]of integer; TMasB=array[1..m,1..m]of integer; var a:TMasA; b:TMasB; i,j,aaa:integer; function AA(x:pointer;z:integer):integer; var s,i,j:integer;{используемые переменные} y:^Integer;{указатель на тип Integer} begin s:=0; for i:=1 to z do for j:=1 to z do if j>i then begin {считаем адрес указателя на элемент массива i,j} y:=ptr(seg(x^),ofs(x^)+2*(z*(i-1)+(j-1))); {суммируем со значением на которое указывает указатель} s:=s+y^; end; {присваиваем результат} AA:=s; end; begin {для массива А, создаем и выводим массив} aaa:=0; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:3); if j>i then aaa:=aaa+a[i,j]; end; writeln; end; {выводим результат} writeln(AA(@a,n):6,aaa:6); {для массива В, создаем и выводим массив} aaa:=0; for i:=1 to m do begin for j:=1 to m do begin b[i,j]:=random(20); write(b[i,j]:3); if j>i then aaa:=aaa+b[i,j]; end; writeln; end; {выводим результат} writeln(AA(@b,m):6,aaa:6); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 138.779

Уважаемые эксперты, помогите, пожалуйста, реализовать с помощью функции одну программу. Написать функцию, которая для заданного линейного массива находит сумму его элементов, при том, что i(номер элемента) не делится на квадрат какого-то числа, большего 1. Заранее спасибо.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Верещагин Михаил! Решение задачи в приложении. Даны необходимые пояснения. Приложение: uses crt; type Tmass=array[1..100]of integer;{тип массива} var a:Tmass; m,i:integer; function Summ(ms:Tmass;n:integer):integer; {передаем в функцию массив и его размерность, выдает сумму} var mn:set of byte; {вспомогательное множество} t,k,j,sum:integer; {разные локальные переменные} begin mn:=[]; {пустое множество} t:=round(sqrt(n)); {корень из n} for i:=2 to t do begin include(mn,sqr(i)); {наполняем множество квадратами чисел от 2 до корень из n} end; sum:=0; for i:=1 to n do begin k:=0; for j:=2 to t do begin {если номер i делится на квадрат, то считаем} if (i mod sqr(j) = 0)and(sqr(j) in mn) then k:=k+1; end; if k=0 then sum:=sum+a[i]; {если не делится ни на один квадрат, прибавляем к сумме} end; Summ:=sum; end; begin clrscr; randomize; write('m=');readln(m); for i:=1 to m do begin a[i]:=random(20); {создаем массив и выводим его на экран} write(a[i],' '); end; writeln; writeln('Summa=',Summ(a,m));{вызываем функцию} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 31.05.2008, 17:28 Оценка за ответ: 5

Вопрос № 138.781

Уважаемые эксперты, помогите решить. Написать функцию, которая для заданного линейного массива находит сумму элементов a[i] так чтобы i не делится на квадрат целого числа большего единицы. Заранее спасибо

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

Отвечает: Tribak Здравствуйте, Кочкарев Владислав Геннадьевич! код в приложении, функция kv проверяет не является ли квадратом i, i=1 квадратом она тоже не считает. Функция summa считает сумму элементов a, если i не прошло проверку kv Приложение: program www; const N=20; var a:array [1..N] of integer; i,j:integer; s,l:real; function kv:boolean; var kvad:boolean; begin s:=sqrt(i); j:=trunc(s); if j-s<>0 then kvad:=false else kvad:=true; if i=1 then kvad:=false; kv:=kvad; end; procedure summa; begin l:=0; for i:=1 to N do if not kv then l:=l+a[i]; end; begin randomize; for i:=1 to N do begin a[i]:=random(100); write(a[i],' '); end; writeln; summa; writeln('symma: ',l:4:0); readln; end.

Ответ отправил: Tribak (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 15:02 Оценка за ответ: 5

Вопрос № 138.788

Уважаемые эксперты, помогите написать следующую функцию. Дана квадратная матрица. Найти сумму таких ее элементов, что i - нечетное, а j - простое одновременно. Необходимо задействовать пользовательские функции. Заранее благодарен.

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

Отвечает: Tribak Здравствуйте, Верещагин Михаил! вот программа, вроде все интуитивно понятно Приложение: program www; uses crt; const N=10; var a:array [1..N,1..N] of integer; i,j,s,k:integer; function prostoe:boolean; var pr:boolean; begin pr:=true; for k:=2 to j-1 do if j mod k = 0 then pr:=false; prostoe:=pr; end; function summa:integer; begin for i:=1 to N do if odd(i) then for j:=1 to N do if prostoe then s:=s+a[i,j]; summa:=s; end; begin; clrscr; for i:=1 to N do begin for j:=1 to N do begin a[i,j]:=random(100); write(a[i,j],' '); end; writeln; end; writeln(summa); readln; end.

Ответ отправил: Tribak (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 15:38 Оценка за ответ: 5

Вопрос № 138.807

Составить программу, позволяющую в текст, введенный с клавиатуры, вставить фрагмент “ студенты сдают ” перед каждым встречающимся словом ”экзамен”. Приложение: напишите пожалуста программу самым простым способом

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

Отвечает: SHERRY Здравствуйте, VanekP89! решение Вашей задачи в приложении Приложение: const s = ' students pass '; {строка, которую нужно вставить} var MyStr, rez: string; {считываем строку MyStr результат постепенно записываем в rez} begin readln(MyStr); {считываем строку} rez := ''; {результат изначально пуст} Repeat if pos('examinations', MyStr) <> 0 then {если в строке MyStr есть подстрока 'examinations', то} begin Insert(s, MyStr, pos('examinations', MyStr)); {в строку MyStr вставляем строку s при вхождении в первую строки 'examinations'} rez := rez + Copy(MyStr, 1, pos('examinations', MyStr)+12); {в результат дописываем кусочек подправленной строки} delete(MyStr, 1, pos('examinations', MyStr)+12); {удаляем из исходной строки исправленный фрагмент} end; Until pos('examinations', MyStr)=0; {цикл продолжается до тех пор, пока в исходной строке не останется ни одного вхождения строки 'examinations'} if rez='' then rez := MyStr else rez := rez + MyStr; {если после цикла вхождение строки 'examinations' в строку MyStr найдено не было, то результатом будет сама строка MyStr. В противном случае дописываем в результат оставшиеся в строке MyStr символы} writeln(rez); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 20:00

Вопрос № 138.814

Нужно написать программу. Тема:циклы и разветвления при обработке последовательностей" Задача: Дано натуральное N и действительные числа X1...Xn. Вычислить произведение тех членов,Xi-той последовательности,для которых выполнено условие i<Xi<i+1. Если это на что-то влияет вообще,то ваш ответ оценю)

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Иванова Дарья Сергеевна! Задача с пояснениями в приложении. Удачи!!! Приложение: program q138814; var {N-кол-чисел в последовательности, i-номер тек числа в последовательности} N, i: integer; {x-введенное число, mul-произведение} x, mul: real; begin {Инициализируем произведение} mul:=1; {Получаем кол-во чисел в последовательности} Write('N: '); ReadLn(n); {Обрабатываем последовательность} for i:=1 to N do begin {Получаем очередное число} Write('X', i, ': '); readln(x); {Проверяем условие} if (X > i) and (X < (i+1)) then {Если число удовлетворяет условию, то умножаем его на произведение} mul:=mul*x; end; {Вывод рез-та} Write('Mul = ', mul:8:3); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 31.05.2008, 19:35 Оценка за ответ: 5 Комментарий оценки: Спасибо за понятное объяснение)

Вопрос № 138.835

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

Отправлен: 31.05.2008, 22:44 Вопрос задал: Гноць,Руслан,Валериевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Гноць,Руслан,Валериевич! решение гораздо проще. Если ответ будет TRUE - значит делится, если FALSE - не делится. Приложение: var a: integer; begin readln(a); writeln(a mod 5 = 0); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 22:58

Отвечает: S K A L T Здравствуйте, Гноць,Руслан,Валериевич! Я сделал задачу подразумевающую что n будет целым числом. сначала делим заданное целое число n на 5, round(k)- округляет число, дальше условие: проверяет каким будет последнее число. Приложение: var n:integer; k:real; begin writeln('vvedite chislo'); readln(n); k:=n/5; n:=round(k); writeln('n=',n); if (n div 1 mod 10 = 0) or (n div 1 mod 10 = 5) then writeln('YES') else writeln('No');readln; end.

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 01.06.2008, 13:38

Вопрос № 138.836

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

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

Отвечает: SHERRY Здравствуйте, Гноць,Руслан,Валериевич! Элементы матрицы генерируются случайным образом. При желании - их можно вводить вручную. Для этого меняем строку ms[i,j]:=random(100); на readln(ms[i,j]); Код в приложении. Приложение: const n = 5; {размерность матрицы} var ms: array [1..n, 1..n] of integer; {собственно матрица} i,j, x,y, max: integer; {вспомогательные элементы} begin randomize; {включаем генератор случайных чисел} max := -1; {предполагаем, что изначально максимальный элемент равен -1} for i:=1 to n do begin for j:=1 to n do begin ms[i,j]:=random(100); {Элемент матрицы генерируется из промежутка 0..99} write(ms[i,j]:5); {выводим сгенерированный элемент на экран} if ms[i,j]>max then {вычисляем максимальный элемент} begin max := ms[i,j]; x:=i; y := j; end; end; writeln; end; writeln; writeln('Max element is ', max, '[',x,',',y,']'); {выводим результат на экран} readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 23:08

Вопрос № 138.837

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

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

Отвечает: SHERRY Здравствуйте, Гноць,Руслан,Валериевич! Для решения сей задачи создаём свой тип запись и "пляшем" от него. Текст решения с пояснениями в приложении. Приложение: const n = 5; {количество записей в записной книжке} type zzz = record {наш тип} name: string[20]; {имя контакта} phone: string[10]; {телефон} end; var ms: array [1..n] of zzz; {массив контактов} i: integer; {переменная-счётчик} s: string[20]; {вспомогательная переменная} begin for i:=1 to n do {заполняем записную книжку} begin readln(ms[i].name); {считываем имя} readln(ms[i].phone); {номер телефона} end; writeln; write('Search by name. Please, type name: '); readln(s); {считываем имя для поиска} for i:=1 to n do if ms[i].name = s then {поиск по имени} writeln(ms[i].name, ' -> ', ms[i].phone); writeln; write('Search by phone. Please, type phone: '); readln(s); {считываем номер телефона для поиска} for i:=1 to n do if ms[i].phone = s then {поиск по номеру телефона} writeln(ms[i].phone, ' -> ', ms[i].name); writeln('Search complete!'); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 23:24

Вопрос № 138.841

Здравствуйте уважаемые эксперты!Помогите пожалуйста решить эти задачи, мне они нужны для сдачи госэкзамена. 2. Разработайте программу, определяющую порядок и сумму цифр заданного натурального числа. 3. Дано натуральное число n. Разработайте программу для получения нового числа переставлением цифр исходного числа в обратном порядке. 4. Дан массив целых положительных и отрицательных чисел из n элементов. Разработайте программу, меняющую первый отрицательный элемент с последним элементом массива. 5. Дан двумерный массив размерности n*m. Разработайте программу поиска номера строки и столбца, на пересечении которых находится минимальный элемент. Спасибо.

Отправлен: 31.05.2008, 23:43 Вопрос задала: Азарова Наталька (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: SHERRY !!! Здравствуйте, Азарова! Набросал задачки 3 и 4. P.S. Конечно не моё дело, но задачки на "госы" не оч тянут ;) i:=length(IntToStr(a))-1; Для Pascal-я данная запись неверна, поскольку функция IntToStr НЕ определена. Правильно будет так: str(a, s); i:=length(s)-1; где s:string; ----- ∙ Отредактировал: Gh0stik (Академик) ∙ Дата редактирования: 01.06.2008, 00:40 (MCK) Приложение: #3 var i,a: integer; rez: real; begin rez := 0; readln(a); {считываем число} i:=length(IntToStr(a))-1; {идём на хитрость - определяем его размер, переведя число в строку, и применив функцию length()} Repeat {создаём цикл} rez := rez + (a mod 10)*exp(i*ln(10)); {ответ задачи формируем так: берём отстаток от деления и унмножаем на 10, возведённое в степень i. полученное число прибавляем к результату} a := a div 10; {целочисленно делим исходное число на 10 - таким образом мы убираем из числа последнюю цифру} dec(i); {уменьшаем счётчик на единичку} Until a<1; {цикл завершаем тогда, когда исходное число станет меньше единицы} writeln(rez:1:0); {выводим результат на экран} readln; end. #4 const n = 5; {количество элементов массива} var i, a: integer; {вспомогательные переменные} ms: array [1..n] of integer; {массив} begin randomize; {включаем генератор случайных чисел} a:=-1; {инициализируем переменную, в которой потом будет храниться номер первого отрицательного элемента в массиве} for i:=1 to n do begin ms[i]:=random(10) - 5; {числа генерируются в диапазоне [-5, 4]} write(ms[i]:4); {Выводим сгенерированный элемент на экран} if ms[i]<0 then {если число меньше нуля} if a=-1 then a:=i; {если нам ещё не встречался отрицательный элемент, то запомним его номер} end; i:=ms[a]; {меняем заданные элементы местами} ms[a]:=ms[n]; ms[n]:=i; writeln; for i:=1 to n do write(ms[i]:4); {выводим результат на экран} readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 01.06.2008, 00:25 Оценка за ответ: 5 Комментарий оценки: Спасибо.Все так просто оказывается.

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азарова! По задаче №2 я не понял, что такое порядок цифр, это или их разряд, или номер по порядку с начала, или степень числа 10. Если уточните дополню программы. Сделал в двух вариантах, чисто математически для чисел из диапазонов Longint, и с помощью строк, для чисел до 255 знаков. Второй вариант предпочтительней, т.к. не надо задумываться о длине вводимого числа. В приложении также решение задачи №5. Приложение: Задача 2. Вариант 1. uses crt; var n:longint; u,sum:byte; begin clrscr; write('n=');readln(n); sum:=0; while n>0 do begin u:=n mod 10;{отделяем последнюю текущую цифру} sum:=sum+u; {прибавляем ее} n:=n div 10; {берем число без последней цифры} end; writeln('Summa cifr=',sum); readln; end. Вариант 2. uses crt; var s:string; i,sum,t:word; c:integer; begin clrscr; write('Vvedite chislo: ');readln(s); sum:=0; for i:=1 to length(s)do begin val(s[i],t,c); {преобразуем символ в цифру} sum:=sum+t; {прибавляем ее} end; writeln('Summa chifr=',sum); readln end. Задача 5. uses crt; var n,m,i,j,min,imin,jmin:integer; a:array[1..50,1..50]of integer; begin clrscr; randomize; write('Vvedite kolichestvo strok n=');readln(n); write('Vvedite kolichestvo stolbcov m=');readln(m); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10)-3; write(a[i,j]:3); end; writeln; end; readln; min:=a[1,1];imin:=1;jmin:=1; for i:=1 to n do for j:=1 to m do if a[i,j]<min then begin min:=a[i,j]; {минимум} imin:=i; {номер строки} jmin:=j; {номер столбца} end; writeln('Minimalnyj element v stroke ',imin,' v stolbce ',jmin); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 11:48 Оценка за ответ: 5 Комментарий оценки: Спасибо. насчет порядка цифр я сама не поняла, мне кажется это номер цифры по порядку

Вопрос № 138.857

Приветствую Вас уважаемые эксперты! нужна Ваша помощь в решении задачи!! >> >Имеется текстовый файл Т. Написать программу, которая выводит на экран первую из самых коротких его строк.

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

Отвечает: SHERRY Здравствуйте, Dextrous! Решение Вашей задачи в приложении. При тестировании - создайте в одном каталоге с EXE-файлом файл "MyFile.txt". При поиске минимальной строки учитывайте, что программа не будет работать со строками, длина которых больше 255 символов, а также я опустил при работе пустые строки (если Вы хотите обрабатывать и пустые строки, то условие if (length(s)>0) and (length(s)<length(min)) then преобразите до вида if length(s)<length(min) then Успехов! Приложение: var f: text; {файловая переменная} s, min: string; {вспомогательные переменные} begin Assign(f, 'MyFile.txt'); {задаём файловой переменной файл на диске} Reset(f); {открываем файл для чтение} min := ''; readln(f, min); {читаем из файла первую строку, в надежде, что она будет минимальной} WHILE not EOF(f) do {до тех пор, пока не достигнут конец файла} begin readln(f, s); {считываем из файла строку} if (length(s)>0) and (length(s)<length(min)) {если её длина меньше минимальной, однако и сама строка непуста, } then min := s; {то считаем её минимальной} end; writeln(min); {выводим результат на экран} readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 01.06.2008, 08:40

Вопрос № 138.859

Здравствуйте Уважаемые эксперты!!! нуждаюсь в Вашей помощи, в решении задачи!! >>> Ввести информацию об автолюбителях: фамилия, марка автомобиля, цвет машины. 1. Данные хранить в виде записи с полями – фамилия и инициалы, марка автомобиля, цвет машины. Вывести на экран дисплея сведения об автолюбителях, имеющих автомобиль "Жигули" зеленого цвета. Результат работы программы записать в файл REZ.DAT. 2. Данные хранить в виде записи с полями – фамилия и инициалы, автомобиль - являющаяся записью из трех полей: марка автомобиля, цвет машины, год выпуска. Вывести на экран дисплея сведения об автолюбителях, имеющих автомобиль "Жигули" зеленого цвета, список упорядочить по году выпуска. Результат работы программы записать в файл REZ.DAT. Приложение: (задача на тему: "типизированные файлы")

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

Отвечает: S K A L T Здравствуйте, Dextrous! Я написал вторую задачу. Поиск осуществляется по марке и по цвету, но если нужно именно с "Жигули" и "зеленого цвета" то уберите это: write('vvedite marky avto:'); readln(marka); write('vvedite color avto:'); readln(col); и напишите так: If (avto.mark="Жигули") and (avto.color="зеленый") then.. В первой задаче нужно лишь изменить описание записи вначале: type Tstudent2=record name:string[20]; mark:string[10]; color:string[30]; end; и нужно обращатся не Avto.color или avto.mark, а просто color, mark. Удачи!!! Приложение: uses crt; type Tstudent2=record name:string[20]; avto:record mark:string[10]; color:string[30]; end; end; var name_file:string; ch:char; procedure input(var name_file:string); var f:file of Tstudent2; x:Tstudent2; i,n:integer; begin clrscr; write('vvedite imya filya'); readln(Name_file); Assign(f,name_file); rewrite(f); writeln('kol-vo zapisei'); readln(n); if n>0 then begin For i:=1 to n do begin with X do begin writeln('vvedite dannie ',i,'-go avtolife'); write('vvedite FIO:'); readln(name); write('vvedite mark:'); readln(avto.mark); write('vvedite color:'); readln(avto.color); end; write(f,X) end; writeln('sozdan file iz ',n,'zapisei'); end else writeln('file pystoi'); Close(f); readkey; end; Procedure Open(var name_file:string); var f:file of Tstudent2; begin clrscr; writeln('vvedite imya file:'); readln(name_file); Assign(f,name_file); {$I-} reset(f); {$I+} If IOResult<>0 then begin writeln('net file with name',name_file); name_file:=''; end else begin writeln('file',name_file,'open'); Close(f); end; readkey; end; Procedure Add_Record(var Name_file:string); var f:file of Tstudent2; X:Tstudent2; begin clrscr; assign(f,name_file); {$I-} reset(f); {$I+} If IOResult<>0 then writeln('net file with this name',name_file) else begin Seek(f,Filesize(f)); with X do begin Writeln('vvedite dannie',FileSize(f)+1,'-go avtolybitela'); write('vvedite Fio'); readln(name); write('vvedite mark'); readln(avto.mark); write('vvedite color'); readln(avto.color); end; write(f,X); writeln('zapis dobavlena'); close(f); end; readkey; end; Procedure View(Name_file:string); Var f:file of Tstudent2; X:Tstudent2; begin clrscr; Assign(f,Name_file); {$I-} reset(f); {$I+} If IOResult<>0 then writeln('net file with this name',name_file) else begin writeln('soderzhimoe file:',name_file); writeln('soderzhimoe file:',name_file); writeln('| FIO | mark | color |'); writeln('_______________________________'); while not Eof(f) do begin read(f,X); with X do writeln(name:10,avto.mark:10,avto.color:10); end; close(f); end; readkey; end; Procedure del(name_file:string); var f,temp:file of Tstudent2; x:Tstudent2; k,i:integer; begin clrscr; Assign(f,name_file); {$I-} reset(f); {$I+} If IOResult<>0 then writeln('net file with this name',name_file) else begin writeln('FILE',name_file,'imeet',Filesize(f),'zapisei'); write('vvedite nomer zapisi dlya delete #='); readln(k); if (k<1) or (k>Filesize(f)) then Writeln('net zapisi c #=',k) else begin Assign(temp,'1.tmp'); Rewrite(temp); For i:=1 to filesize(f) do begin read(f,X); if i<>k then write(temp,X); end; close(f); Close(temp); Erase(f); ReName(temp,Name_file); Writeln('zapis deleted'); end; end; Readkey; end; Procedure Search(Name_file:string); var f:file of Tstudent2; f1:file of Tstudent2; X:tstudent2; Marka:string[10]; Col:string[30]; poisk:boolean; begin clrscr; Assign(f,name_file); Assign(f1,'Rez.dat'); rewrite(f1); {$I-} reset(f); {$I+} If IOResult<>0 then writeln('net feli with this name',name_file) else begin write('vvedite marky avto:'); readln(marka); write('vvedite color avto:'); readln(col); writeln('| FIO | mark | color |'); writeln('_______________________________'); Poisk:=false; while not Eof(f) do begin read(f,X); with X do If (avto.mark=marka) and (avto.color=col) then begin writeln(name:10,avto.mark:10,avto.color:10); Poisk:=true; end; end; Close(f); if not Poisk then writeln('net takoi marki i color',marka,col); end; write(f1,x); Readkey; Close(f1); end; begin Name_file:=''; repeat clrscr; Writeln('1-creat file'); Writeln('2-open file'); Writeln('3-view dannie'); Writeln('4-dobavit dannie'); Writeln('5-delete dannie'); Writeln('6-Search dannie'); Writeln('7-end'); Writeln; Write('viberete pynkt menu'); Readln(ch); Case ch of '1':Input(name_file); '2':Open(name_file); '3': if name_file <> '' then View(name_file) else begin Writeln('net name of file(viberite 1 or 2)'); readkey; end; '4':if name_file <> '' then Add_record(name_file) else begin Writeln('net name of file(viberite 1 or 2)'); readkey; end; '5':if name_file <> '' then Del(name_file) else begin Writeln('net name of file(viberite 1 or 2)'); readkey; end; '6':if name_file <> '' then Search(name_file) else begin Writeln('net name of file(viberite 1 or 2)'); Readkey; end; end; until Ch = '7'; end.

Ответ отправил: S K A L T (статус: 1-ый класс) Ответ отправлен: 01.06.2008, 13:49

Отвечает: Пупорев Юрий Борисович Здравствуйте, Dextrous! Решение обеих задач, выполненных в едином стиле, в приложении. Пояснений ко второй задаче мало, т.к. почти все повторяется. Приложение: Задача 1. uses crt; type Tavlub=record {тип запись с полями} fio:string[20];{фио} mar:string[20];{марка} clr:string[20];{цвет} end; var sp:array[1..50]of Tavlub;{массив записей, список а-любителей} i,n:integer; {счетчикм} c:char; {переменная символьного типа} f:file of Tavlub;{типизированный файл} begin clrscr; n:=0; repeat n:=n+1; writeln('Avtolubitel ',n); {вводим данные в список} write('Familia I.O.: ');readln(sp[n].fio); write('Marka: ');readln(sp[n].mar); write('Color: ');readln(sp[n].clr);{после ввода 2 раза Enter} c:=readkey; {если конец ввода, то Esc} until c=#27; assign(f,'REZ.DAT');{создаем и связываем с переменной файл} rewrite(f);{открываем для записи} writeln; writeln('Vladelcy zelenyh zigulej:'); writeln; for i:=1 to n do {ищем по условию} if (sp[i].mar='ziguli')and(sp[i].clr='green') then begin writeln(sp[i].fio); {выводим на экран} write(f,sp[i]); {записываем в файл} end; readln; close(f); {закрываем файл} end. Задача 2. uses crt; type Tavlub=record fio:string[20]; {поля владельца} auto:record mar:string[20];{поля авто} clr:string[20]; god:word; end; end; var sp:array[1..50]of Tavlub; i,n,j:integer; c:char; bf:Tavlub; {буфер при сортировке} f:file of Tavlub; begin clrscr; n:=0; repeat n:=n+1; writeln('Avtolubitel ',n); write('Familia I.O.: ');readln(sp[n].fio); write('Marka: ');readln(sp[n].auto.mar); write('Color: ');readln(sp[n].auto.clr); write('God vypuska: ');readln(sp[n].auto.god); c:=readkey; until c=#27; assign(f,'REZ.DAT'); rewrite(f); writeln; writeln('Vladelcy zelenyh zigulej:'); writeln; for i:=1 to n do if sp[i].auto.clr='green' then begin writeln(sp[i].fio); write(f,sp[i]); end; readln; for i:=1 to n-1 do for j:=1 to n-1 do if sp[j].auto.god>sp[j+1].auto.god then {по полю год} begin bf:=sp[j]; sp[j]:=sp[j+1]; {сортируем всю запись} sp[j+1]:=bf; end; writeln; writeln('Spisok po vozrastaniu goda vypuska:'); writeln; for i:=1 to n do begin writeln(sp[i].fio:10,sp[i].auto.mar:8,sp[i].auto.clr:8,sp[i].auto.god:6); write(f,sp[i]); end; readln; close(f); end. end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 01.06.2008, 14:49

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