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

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

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

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

Николай // Programmator Статус: Студент Рейтинг: 163 ∙ повысить рейтинг >>

Micren Статус: Студент Рейтинг: 122 ∙ повысить рейтинг >>

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

Выпуск № 787
от 18.01.2009, 17:05

Вопрос № 157465: Добрый вечер Уважаемые эксперты, задача следующая: В матрице D(m,n) найти "седловые точки" и их координаты, либо установить, что таких точек нет. "Седловой точкой" в матрице называется элемент, являющийся одновременно наибол...

Вопрос № 157.465

Добрый вечер Уважаемые эксперты, задача следующая: В матрице D(m,n) найти "седловые точки" и их координаты, либо установить, что таких точек нет. "Седловой точкой" в матрице называется элемент, являющийся одновременно наибольшим в столбце и наименьшим в строке. "Седловых точек" может быть несколько (в этом случае они имеют равные значения). Пожалуйста. Помогите. Приложение:

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

Отвечает: Micren Здравствуйте, Гриценко Денис Николаевич! Надеюсь это то, что Вам нужно. Приложение: program Pascal_157465; { Размерность матрицы подставьте свои числа } const M=4; N=3; var D:array[1..M,1..N]of double; i,j,MinCol,Count:integer; isFound:boolean; begin { Вводим матрицу } WriteLn('Enter Matrix(',M,'x',N,')'); for i := 1 to M do for j := 1 to N do begin Write('D[',i,',',j,']='); ReadLn(D[i,j]); end; { Печатаем ее для контроля } WriteLn('Source Matrix'); for i := 1 to M do begin for j := 1 to N do Write(D[i,j]:7:4,' '); WriteLn; end; { Счетчик точек } Count:=0; { Перебираем по строкам } for i := 1 to M do begin { Находим минимальный элемент в строке } MinCol:=1; for j := 2 to N do if D[i,j]<D[i,MinCol] then MinCol:=j; { Флаг true соответствует - найдена точка } isFound:=true; { Идем по столбцу } for j := 1 to M do if i<>j then if D[j,MinCol]>D[i,MinCol] then begin { Если не максимальный в столбце } isFound:=false; { Установить флаг } break; end; { Проверяем найдена ли точка и печатаем ее } if isFound then begin Inc(Count); WriteLn('Found D[',i,',',MinCol,']=',D[i,MinCol]:7:4); end; end; if Count>0 then WriteLn('Found ',Count,' points') else WriteLn('Not found'); ReadLn; end.

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

Вопрос № 157.483

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

Отправлен: 12.01.2009, 20:16 Вопрос задал: Абельхарисов Руслан/Marked One (статус: Практикант) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Micren Здравствуйте, Абельхарисов Руслан/Marked One! Программа довольно запутанная(и скорее всего ее можно оптимизировать). Выкладываю, поскольку никто до сих пор не ответил. Прямоугольники могут произвольно располагаться в пространстве. Производится проверка на возможность построить прямоугольник как таковой. Используется целочисленная арифметика, чтоб не морочить голову с возможными ошибками округления(компьютерная математика видите ли). Приложение: program Pascal_157483; { Количество известных точек } const CPoints=3; type { Тип точка } TPoint=record x,y:integer; end; { Тип длина отрезка в квадрате , чтоб избежать ошибок округления } TLen2=record len2:integer; p1,p2:integer; { Между точками } end; var Points:array[1..CPoints+1]of TPoint; { Массив точек } Len2:array[1..CPoints]of TLen2; { Длин отрезков } i,j,dx,dy:integer; tmpLen:TLen2; numP90:integer=0; pSet:set of 1..3; begin { Вводим 3 точки } WriteLn('Enter 3 points'); for i := 1 to Cpoints do begin Write('X[',i,'] Y[',i,'] : '); ReadLn(Points[i].x,Points[i].y); end; { Вычисляем длины^2 между ними } for i := 1 to CPoints do begin dx:=Points[i].x-Points[i mod 3 + 1].x; dy:=Points[i].y-Points[i mod 3 + 1].y; with Len2[i] do begin len2:=dx*dx+dy*dy; p1:=i; p2:=i mod 3 +1; end; end; { Сортируем длины^2 в порядке возрастания } for i := 1 to CPoints-1 do begin for j := i+1 to CPoints do if Len2[i].len2>Len2[j].len2 then begin tmpLen:=Len2[i]; Len2[i]:=Len2[j]; Len2[j]:=tmpLen; end; end; { Проверяем по теореме Пифагора } if Len2[1].len2+Len2[2].len2<>Len2[3].len2 then WriteLn('This is not a rectangle') else begin with Points[4] do begin { Находим точку не принадлежащую гипотенузе } pSet:=[1,2,3]-[Len2[3].p1,Len2[3].p2]; for i := 1 to CPoints do if i in pSet then begin numP90:=i; { Это она } break; end; { Вычисляем x и y из геометрических соображений } x:=Points[Len2[3].p1].x+Points[Len2[3].p2].x-Points[numP90].x; y:=Points[Len2[3].p1].y+Points[Len2[3].p2].y-Points[numP90].y; WriteLn('X=',x,' Y=',y); { Печатаем } end; end; ReadLn; end.

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

Вопрос № 157.530

Здравствуйте. Подскажите правильно ли я представил данную формулу для программы на паскале (exp(x)+exp(-x))/2-SQR(SQR(x)) Заранее спасибо.

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

Отвечает: Micren Здравствуйте, Арнст Яков! Да. Правильно. Но, на мой взгляд, чем 2 раза вызывать sqr(), с передачей параметра через стек, уж лучше 4 раза умножить x*x*x*x. Поскольку современные компиляторы породят в случае вызова функций код типа: sub esp, 8 fld QWORD PTR _x$[ebp] fstp QWORD PTR [esp] call ?sqr@@YANN@Z ; sqr fstp QWORD PTR [esp] call ?sqr@@YANN@Z ; sqr В случае умножения: fld QWORD PTR _x$[ebp] fmul QWORD PTR _x$[ebp] fmul QWORD PTR _x$[ebp] fmul QWORD PTR _x$[ebp] Что является гораздо более оптимальным.

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

Отвечает: Alexnik Здравствуйте, Арнст Яков! Все правильно, для 4 степени X рационально использовать sqr

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

Вопрос № 157.549

(на разветвление) Дан номер года. Найти число дней в этом году. Указание. В современном (григорианском) календаре каждый год, номер которого делится на 4, является високосным, за исключением тех, которые делятся на 100 и не делятся на 400. Например, 1900 год – не високосный, 2000 – високосный. Високосный год – 366 дней, обычный год – 365 дней.

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа несложная. Приложение: program Pascal_157549; var Year,Days:Word; begin Write('Year='); ReadLn(Year); if Year mod 4 = 0 then begin { Если делится на 4 } if (Year mod 100 = 0)and(Year mod 400<>0) then Days:=365 { Если делится на 100 и не делится на 400 } else Days:=366; end else Days:=365; WriteLn('Days=',Days); ReadLn; end.

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

Вопрос № 157.550

Вычислить значение следующих функций в указанном интервале с шагом h У=3√sin(в квадрате) х+1/3, х€(0;1), h = 0,04

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа простая и достаточно прокомментирована. Приложение: program Pascal_157550; { Задаем начальное, конечное значение и шаг } const xStart=0.0; xEnd=1.0; h=0.04; { Ваша Функция } function f(x:double):double; begin f:=3*sqrt(sqr(sin(x))+1.0/3.0); end; var x:double; begin { Задаем начальное значение } x:=xStart; { Пока х в интервале } while x<=xEnd do begin { Печатаем аргумент и значение } WriteLn('f(',x:5:2,')=',f(x):8:4); x:=x+h; { Шагаем дальше } end; ReadLn; end.

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

Вопрос № 157.551

Даны натуральные числа от 35 до 87. Найти и напечатать те из них, которые при делении на 7 дают остаток 1, 2 или 5.

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа проста. Приложение: program Pascal_157551_1; const startVal=35; endVal=87; var i:integer; begin for i := startVal to endVal do { Проверяем остаток } case i mod 7 of 1,2,5:Write(i:7,' '); { Если 1,2,5} end; WriteLn; ReadLn; end.

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

Вопрос № 157.552

ввести с клавиатуры 10 чисел – положительных и отрицательных. Заменить все отрицательные числа их модулями и напечатать все полученные десять чисел.

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

Отвечает: Костя Симанович Здравствуйте, Иванов Виктор Олегович! Задача не сложная, как вариант могу предложить решение с массивом, задаём 10 чисел, обрабатываем и выводим результат, начальный и конечный для наглядности. Модуль числа выводит функция ABS(a). Удачи. Приложение: program chisla; const n = 10; {кол-во чисел, можно изменить} var i : integer; a : array[1..n, 1..2] of real; {использую массив, только для наглядности} begin for i := 1 to n do begin writeln('Введите ', i, ' число.'); readln(a[i, 1]); if a[i,1] < 0 then a[i, 2] := abs(a[i, 1]) else a[i, 2] := a[i, 1]; end; {выводим результат} writeln('Введённые числа.'); for i := 1 to n do write(a[i, 1]:3:0); writeln; writeln('Результат.'); for i := 1 to n do write(a[i, 2]:3:0); readln; end.

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа прокомментирована Приложение: program Pascal_157551; const N=10; var A:array[1..N]of integer; i:Byte; begin { Ввод последовательности } WriteLn('Enter ',N,' numbers'); for i := 1 to N do Read(A[i]); ReadLn; { Печатаем введенные данные для контроля } WriteLn('You enter the following number'); for i := 1 to N do Write(A[i]:7,' '); WriteLn; { Перебор последовательности и замена отрицательных } for i := 1 to N do if A[i]<0 then A[i]:=-A[i]; { Печатаем результат } WriteLn('The resulting sequence'); for i := 1 to N do Write(A[i]:7,' '); WriteLn; ReadLn; end.

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

Вопрос № 157.553

С помощью оператора while напишите программу вывода всех четных чисел в диапазоне от 2 до 100 включительно

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа несложна для понимания. Приложение: program Pascal_157553; const endVal=100; startVal=2; var i:Word; begin i:=startVal; while i<=endVal do begin { odd() возвращает true, если аргумент нечетный } if not odd(i) then Write(i:7,' '); Inc(i); end; ReadLn; end.

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

Вопрос № 157.554

Здравствуйте! У меня такой задача...не могу составить программу данного типа : *Сформеруйте квадратную матрицу размерности M<20 след. вида 1 0 0 . . 2 1 0 . . 3 2 1 . . . . . . . . М М-1 М-2 Прошу помочь! Зарание спасибо!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Берестюк евгений Анатольевич! Строка a[ i , j ]:=ord( j <=i )*( i-j+1 ); формирует заданную матрицу. В ней использованно свойство логического типа как перечисляемого, т.е. true=1, false=0. Выводится несколько матриц, максимальный размер 10 и уменьшается до 2, если я правильно понял условие М М-1 М-2. Если это элементы матрицы, то Вам нужно убрать внешний цикл. Удачи! Приложение: var a:array[1..10,1..10]of integer; b,i,j:integer; begin {меняем размер массива} for b:=10 downto 2 do begin for i:=1 to b do begin for j:=1 to b do begin {формируем и выводим его} a[i,j]:=ord(j<=i)*(i-j+1); write(a[i,j]:5); end; writeln; end; {следующий} readln; end; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: Alexnik Здравствуйте, Берестюк Евгений Анатольевич! Если я Вас правильно понял, тут один из вариантов задачи с квадратными матрицами (выбор элементов на главной диагонали, выше или ниже ее, побочной и т.д.) Тогда наиболее простое решение для М=15 вот (можете заменить константу М на новое значение) Приложение: Program Pas_157554; Const M=15; Var Matr:array [1..M,1..M] of integer; i,j : integer; Begin For i:=1 to M do {обнуляем элементы массива} For j:=1 to M do Matr [i,j]:=0; For i:=1 to M do {перебор строк от 1 до М включительно} For j:=1 to i do {перебор столбцов от 1 до значения i включительно, тогда элементы ниже } Matr[i,j]:=i+1-j; {главной диагонали выч. по след. закону, а элементы на главной диагонали = 1} For i:=1 to M do Begin For j:=1 to M do Begin Write (Matr[i,j]:5); End; Writeln; End; Readln End.

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

Вопрос № 157.555

Составить программу, определяющую, является ли данное число N простым

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа простая и снабжена комментариями. Приложение: program Pascal_157555; var N,test:Word; sqrtN:Word; isSimple:Boolean; begin { Вводим N } Write('N='); ReadLn(N); { Имеет смысл искать до N^0.5} sqrtN:=Trunc(sqrt(N)); isSimple:=true; { Флаг если простое } if N mod 2 <> 0 then begin test:=3; while test<=sqrtN do begin if N mod test = 0 then begin { Если найден делитель устанавливаем флаг и выходим } isSimple:=false; break; end; Inc(test,2); end; end else if N<>2 then isSimple:=false; if isSimple then WriteLn(N,' - simple') else WriteLn(N,' - not simple'); ReadLn; end.

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

Вопрос № 157.565

задача на разветвление - найти значение выражения (значение х вводится через клавиатуру) с проверкой нулевых значений знаменателя: 1/х-5

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Комментарии, думаю, излишни. Приложение: program Pascal_157565; var x:double; begin Write('Enter x='); ReadLn(x); if x=0 then WriteLn('Denominator can not be zero') else WriteLn('Result : ',(1.0/x-5):8:4); ReadLn; end.

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

Вопрос № 157.581

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Haze832! Решение с комментариями в приложении. Сначала надо создать текстовый файл в блокноте, лучше в одной папке с программой. В файле в первой строке сделать заголовок, затем в следующих строказ написать через пробелы название, длину, бассейн. Образец файла я прилагаю. Приложение: uses crt; type Trek=record {тип запись с полями по условию} naz:string[20];{название реки} dln:word; {длина} bas:word; {площадь басейна} end; var tb:array[1..100] of Trek;{массив записей} f:text; {текстовый файл} n,i,max,imax,t:word; c:integer; s:string; begin clrscr; assign(f,'Reki.txt');{связываем переменную с реальным файлом} reset(f); {открываем его для чтения} writeln('Spisok rek:'); writeln; n:=0; while not eof(f) do {пока не конец файла} begin readln(f,s); {читаем певую строку(заголовок)} writeln(s); {выводим на экран} readln(f,s); {читаем следующие строки} writeln(s); {выводим на экран} n:=n+1; {считаем} while pos(' ',s)>0 do delete(s,pos(' ',s),1);{в строках файла данные могут быть разделены не одним пробелом(у меня так и сделано), поэтому лишние пробелы надо удалить, оставив по одному, здесь в одинарных кавычках(апострофах) по 2! пробела } tb[n].naz:=copy(s,1,pos(' ',s)-1);{читаем первое слово и записываем в название} delete(s,1,pos(' ',s)); {удаляем его} val(copy(s,1,pos(' ',s)-1),t,c);{превращаем в число следующее слово} tb[n].dln:=t; {записываем в длину} delete(s,1,pos(' ',s));{удаляем} val(copy(s,1,pos(' ',s)-1),t,c);{превращаем в число последнее слово} tb[n].bas:=t; {записываем в бассейн} end; close(f); {закрываем файл} writeln; max:=tb[1].dln;imax:=1; {ищем максимальную длину} for i:=1 to n do if tb[i].dln>max then begin max:=tb[i].dln; imax:=i; end; writeln('Samaja dlinnaja reka ',tb[imax].naz);{выводим название} max:=tb[1].bas;imax:=1; {ищем максимальный бассейн} for i:=1 to n do if tb[i].bas>max then begin max:=tb[i].bas; imax:=i; end; writeln('Samayj bolshoj bassejn u reki ',tb[imax].naz);{выводим название} readln end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

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

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