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

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

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

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

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

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

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

Выпуск № 735
от 24.11.2008, 04:05

Вопрос № 150901: уважаемые Эксперты!! помогите пожалуста с решением. "В массиве А(a(1)......a(n)), все элементы, равные 0 (нулю), поставить сразу после максимального элемента данного массива". P.S.Нужно сделать так чтобы остальные после максимальног...

Вопрос № 150.901

уважаемые Эксперты!! помогите пожалуста с решением. "В массиве А(a(1)......a(n)), все элементы, равные 0 (нулю), поставить сразу после максимального элемента данного массива". P.S.Нужно сделать так чтобы остальные после максимального сдвигал на позицию больше(если один ноль) и вставлял ноль после максимального. Нужно учесть что ноль может быть как до максимального так и после, Заранее спасибо!!

Отправлен: 18.11.2008, 09:54 Вопрос задал: S K A L T (статус: 1-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Пупорев Юрий Борисович Здравствуйте, S K A L T ! Решение с комментариями в приложении. Приложение: uses crt; const n=20; var a:array[1..n]of integer; i,j,max,imax:integer; begin clrscr; randomize; writeln('Исходный массив:'); max:=-maxint;imax:=1; {находим максимальный элемент и его номер} for i:=1 to n do begin read(a[i]); {вводим 20 элементов в строку через пробел} if a[i]>max then begin max:=a[i]; {макс} imax:=i; {номер} end; end; readln; for i:=imax downto 1 do {изучаем первую половину с конца, чтобы не нарушить номер очередного элемента при сдвиге массива влево} if a[i]=0 then {если ноль} begin for j:=i to imax-1 do a[j]:=a[j+1]; {cдвигаем часть массива влево на 1, удалем 0} a[imax]:=0; {вставляем его на бывшее место максимального} end; for i:=imax+1 to n do {вторую половину наоборот обследуем сначала, т.к. сдвиг будет вправо} if a[i]=0 then begin for j:=i downto imax+2 {сдвигаем вправо на1, удаляем ноль} do a[j]:=a[j-1]; a[imax+1]:=0; {ставим его за бывшим максимальным} end; writeln('max=',max,' imax=',imax); {это для контроля, можно убрать} writeln('Перестановка:'); {выводим исковерканный массив} for i:=1 to n do write(a[i],' '); readln end.

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

Вопрос № 150.912

Добрый день, уважаемые эксперты. Решите пожалуйста задачу(желательно функциями/процедурами) или хотя бы подскажите алгоритм. У же два дня голову ломаю..., в мет. пособиях сходного примера не нашел. В одномерном массиве(произвольной длины) удалить найбольшую цепочку элементов кратных двум. Например: исх. массив 125136847 получается 125137

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

Отвечает: Verena Здравствуйте, Bulletproof! Полагаю, речь не идёт об использовании динамической памяти, впрочем, алгоритмических изменений это всё равно не потребует. В процедуры можно вынести функционал по поиску нужной цепи (в форме позиции начала и длины, это процедура SearchChain (массив, размерность, позиция, длина), где позиция и длина - возвращаемые параметры) и по удалению из массива цепочки заданной длины с определённой позиции (процедура DelElements (массив, размерность, позиция, длина), где массив и размерность - возвращаемые параметры). Массив в обе процедуры передаётся по ссылке (через var), чтобы не хранить его дополнительную копию в памяти. Процедура поиска цепи работает следующим образом: в цикле двигаемся по массиву, если элемент делится на два - наращиваем счётчик, если нет - проверяем, не длиннее ли текущая цепь максимальной (если да, то переписываем максимальное значение и пересохраняем позицию на текущее значение индикатора), обнуляем счётчи к и записываем в индикатор позиции номер следующего элемента. Если в массиве несколько цепей максималбной длины - вернётся характеристика первой. Процедура удаления работает обычным образом - замещает элементы с заданной позиции элементами с позиции текущей + длина цепи, а затем уменьшает размерность. Таким образом, в основной программе остаётся лишь ввести данные, вызвать поочерёдно две процедуры и вывести результат. Решение в приложении. Удачи! Приложение: Type mas = array [1..100] of integer; {Тип массива} Var a: mas; {Массив} i, n, k, p: integer; procedure DelElements (var a: mas; var n: integer; p, k: integer); {Процедура удаления элементов, параметры: массив, размерность, позиция, число удаляемых элементов} Var i: integer; begin if k<>0 then {Если есть, что удалять} begin for i:=p to n-k do a[i]:= a[i+k]; {Сдвигаем хвост массива на удаляемый отрезок} n:= n-k; {Уменьшаем размерность} end; end; procedure SearchChain (var a: mas; n: integer; var p: integer; var k: integer); {Процедура поиска позиции и длины максимальной цепи} Var i, max, maxp: integer; begin k:= 0; max:= 0; p:=1; maxp:= 1; {Первоначальные значения} for i:=1 to n do if a[i] mod 2 = 0 then inc (k) {Если делится на 2 - наращиваем счётчик} else {Иначе} begin {Если счётчик перерос максимальный - перезапоминаем его и позицию} if k>max then begin max:= k; maxp:= p; end; k:= 0; p:=i+1; {Обнуляем счётчик и меняем позицию на текущую} end; k:= max; p:= maxp; {Возвращаем найденные значения} end; begin readln (n); {Считываем данные} for i:=1 to n do readln (a[i]); SearchChain (a, n, p, k); {Ищем цепь} DelElements (a, n, p, k); {Удаляем её} writeln; {Выводим результат} writeln ('Rezult: '); for i:=1 to n do write (a[i]:4); end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 150.922

Дана действительная матрица размера m×n. Определить числа b1, ... , bm, равные соответственно разности наибольших и наименьших значений элементов строк.

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

Отвечает: Шичко Игорь Здравствуйте, Иванов Виктор! Предлагаю Вам следующий вариант решения. Код в приложении. Приложение: var m, n, i, j, min, max: integer; a: array[1..100, 1..100] of integer; b: array[1..100] of integer; begin readln(m); readln(n); for i:= 1 to m do {формирование исходного массива} begin for j:= 1 to n do begin if Odd(i+j) then a[i, j]:= Random(20) else a[i, j]:= (-1) * Random(20); write(a[i, j]:5); end; writeln; end; for i:= 1 to m do begin max:= a[i,1]; min:= a[i,1]; for j:= 2 to n do begin if a[i, j] > max then max:= a[i, j]; {поиск мин и макс по строке} if a[i, j] < min then min:= a[i, j]; end; b[i]:= max - min; {массив b} end; writeln; for i:= 1 to m do write(b[i]:5); {вывод результата} readln; end.

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

Вопрос № 150.927

Уважаемые эксперты помогите написать программу на числаки по матрицам: определитель матрицы третьего и четвертого порядка за ранее спасибо ...

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

Отвечает: Шичко Игорь Здравствуйте, Иванов Виктор! Порядок расчета определителей: http://matema.narod.ru/3.1.4.htm#разложение%20по%20элементам%20строки%20или%20столбца Примерный код с использованием функции в приложении. Приложение: var a: array[1..3, 1..3] of integer; b: array[1..4, 1..4] of integer; opr_3, opr_4, i, j: integer; function opr_three(a1,a2,a3,b1,b2,b3,c1,c2,c3: integer): integer; {функция определителя 3-го порядка} var temp: integer; begin temp:= 0; temp:= temp + a1*b2*c3 + a2*b3*c1 + a3*b1*c2; temp:= temp - a1*b3*c2 - a2*b1*c3 - a3*b2*c1; opr_three:= temp; end; begin writeln('Matrica 3*3 :'); for i:= 1 to 3 do begin for j:= 1 to 3 do begin if Odd(i+j) then a[i,j]:= Random(20) else a[i,j]:= (-1) * Random(20); write(a[i,j]:5); end; writeln; end; opr_3:= 0; opr_3:= opr_three(a[1,1], a[1,2], a[1,3], a[2,1], a[2,2], a[2,3], a[3,1], a[3,2], a[3,3]); {вычисление опр. 3-го порядка} writeln('Opredelitel 3*3 = ', opr_3:10); writeln; writeln('Matrica 4*4 :'); for i:= 1 to 4 do begin for j:= 1 to 4 do begin if Odd(i+j) then b[i,j]:= (-1) * Random(3) else b[i,j]:= Random(3); write(b[i,j]:5); end; writeln; end; {вычисление опр. 4-го порядка} opr_4:= 0; opr_4:= opr_4 + b[1,1] * opr_three(b[2,2], b[2,3], b[2,4], b[3,2], b[3,3], b[3,4], b[4,2], b[4,3], b[4,4]); opr_4:= opr_4 - b[1,2] * opr_three(b[2,1], b[2,3], b[2,4], b[3,1], b[3,3], b[3,4], b[4,1], b[4,3], b[4,4]); opr_4:= opr_4 + b[1,3] * opr_three(b[2,1], b[2,2], b[2,4], b[3,1], b[3,2], b[3,4], b[4,1], b[4,2], b[4,4]); opr_4:= opr_4 - b[1,4] * opr_three(b[2,1], b[2,2], b[2,3], b[3,1], b[3,2], b[3,3], b[4,1], b[4,2], b[4,3]); writeln('Opredelitel 4*4 = ', opr_4:10); readln; end.

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

Вопрос № 150.931

дано натуральное число n, действительные числа a1, ... , an. Получить min(a1, a3, ... )

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение задачи в приложении. Приложение: uses crt; const n=10; var a:array[1..n] of real; i:integer; min:real; begin clrscr; randomize; min:=100; for i:=1 to n do begin a[i]:=10*random; write(a[i]:5:2); if (a[i]<min ) and (i mod 2<>0)then min:=a[i]; end; writeln; write('Min=',min:0:2); readln end.

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

Вопрос № 150.934

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

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

Отвечает: Жиляев М. Ю. Здравствуйте, Иванов Виктор! Вот програмка uses crt; var a:array[1..50] of integer; i:byte; s:integer; Begin clrscr; {очистка экрана} randomize; {инициализация генератора случайных чисел с произвольным значением} s:=0; {обнуление переменной для суммы} for i:=1 to 50 do begin a[i]:=random(20)-10; {или, если нужен ручной ввод, эти две строки заменить} write(a[i]:4); {на readLn(a[i]); } if (a[i]<0) and (odd(a[i])=true) then s:=s+a[i];{проверка условий} end; writeLn; writeLn(s:8); {вывод суммы} readkey; {Ожидание нажатия любой клавиши} End.

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

Вопрос № 150.940

Злравствуйте уважаемые эксперты. Всем доброго времени суток. Помогите решить пожалйста вот такую задачу: Дан файл assort, создать сведения об игрушках: указав название игрушки ее стоимость в рублях, и возростные границы. Получить название самой дорогой игрушки для детей до n-х лет. Не получается найти самую дорогую игрушку. Заранее спасибо. Приложение: program LR2; {$APPTYPE CONSOLE} uses SysUtils; Type mas = array[1..100] of integer; av = array[1..70] of string; var bf : text; name : av; name2 : String[45]; cena,max : mas; ogr : mas; n,i,ogr2,x : integer; begin Writeln('Vvedite kolicestvo igruhek '); Readln(n); Assign(bf, 'assort.txt'); Rewrite(bf); for i:= 1 to n do begin Write('Vvedite Nazvanie ugruhki: '); Readln(name[i]); Write(bf, name[i],' '); Write('Vvedite stoimostb (rub): '); Readln(cena[i]); Write(bf, cena[i],' '); Write('Vvedite vozrostnbIe ogran-ya: '); Readln(ogr[i]); WriteLn(bf, ogr[i],' '); Writeln; end; Close(bf); reset(bf); WriteLn('Do kakogo vozrasta vas interesuyt igruhki'); ReadLn(ogr2); WriteLn; WriteLn('Samaya dorogaya igruhke dlya detey do ',ogr2,'-x let.: '); WriteLn; ------------------------ здесь должно быть нахождение самой дорогой игрушки. ------------------------ close(bf); ReadLn; end.

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

Отвечает: Шичко Игорь Здравствуйте, Довиденко Д.А.! Предлагаю Вам постмотреть мой код к ответу на вопрос № 149036. Код в приложении. Может он лучше подойдет. Приложение: Var f: file of Toy; z: Toy; fname: string; i, maxPrice: integer; begin fname:='c:asort.txt'; {имя файла} assign (f, fname); rewrite(f); for i:=1 to 10 do {установите нужное число записей} begin writeln('Zapis ', i:5); readln(z.name); {наименование} readln(z.price); {цена} readln(z.LowAge); {нижняя граница} readln(z.HighAge); {верхняя граница } write(f, z); end; close(f); assign (f, fname); {присоединяем файл} reset (f); {для чтения} maxPrice:= -1; while not eof(f) do begin read (f, z); if (z.name='Konstruktor') and (z.price>maxPrice) and (z.LowAge = 2) and (z.HighAge=5) then maxPrice:= z.price; end; if maxPrice<0 then writeln ('Net konstruktorov') else writeln ('Price: ', maxPrice); {Вывод максимальной цены} close (f); readln; end.

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

Вопрос № 150.962

Уважаемые эксперты,извините за беспокойство!Помогите решить,если можно эти две задачи: 1.Используя процедуру,найти наибольшее из трех чисел. 2.Вычислить с помощью процедуры значение выражения а:=(3n!+2m!)/(m+n)! И еще на матрицу: Удалить столбец,в котором встретиться минимальный элемент. Заранее преогромное спасибо!

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

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Evela! Вторая и третья задача в приложении. Удачи!!! Исправлено по просьбе автора ответа. -------- ∙ Отредактировал: Зенченко Константин Николаевич, Профессор ∙ Дата редактирования: 20.11.2008, 12:21 (время московское) Приложение: №2 {Функцмя для вычисления факториала} function Fact(a: integer): integer; begin if a = 1 then Fact := 1 else Fact := Fact(a - 1); end; {Процедура для вычисления} procedure func(m, n: integer; var a: real); begin a := (3 * Fact(n) + 2 * Fact(m))/Fact(m + n); end; var m, n: integer; a: real; begin {Получаем данные} Write('n: '); ReadLn(n); Write('m: '); readLn(m); {Вычисляем} func(m, n, a); {Выводим результат} Write('Ответ: ', a:6:2); ReadLn; end. №3 const N = 5; M = 3; var Matrix: array [1..M, 1..N] of integer; NewMatrix: array [1..M, 1..N - 1] of integer; min, minj: integer; i, j, ni, nj: integer; begin randomize; WriteLn('Исходная матрица ', M, 'x', N, ' заполненная случайными числами: '); for i := 1 to M do begin for j := 1 to N do begin Matrix[i, j] := random(100) - 50; Write(Matrix[i, j]:4); end; WriteLn; end; min := Matrix[1, 1]; minj := 1; for i := 1 to M do for j := 1 to N do if Matrix[i, j] < min then begin min := Matrix[i, j]; minj := j; end; WriteLn('Минимальный элемент матрицы: ', min, ' в столбце №', minj); WriteLn('Измененная матрица: '); ni := 1; for i := 1 to M do begin nj := 1; for j := 1 to N do begin if j = minj then continue; NewMatrix[ni, nj] := Matrix[i, j]; Write(NewMatrix[ni, nj]:4); inc(nj); end; inc(ni); WriteLn; end; ReadLn; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Evela! Решение первой задачи в приложении. Приложение: uses crt; procedure Max3(a,b,c:integer;var max:integer); begin max:=a; if b>max then max:=b; if c>max then max:=c; end; var x,y,z,mx:integer; begin clrscr; write('x=');readln(x); write('y=');readln(y); write('z=');readln(z); Max3(x,y,z,mx); write('Max=',mx); readln end.

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

Вопрос № 150.973

Зравствуйте эксперты, очень нужна программа, не как не могу сообразить, просто горю от этого хависит зачет на сессии!!! ПОМОГИТЕ!!!Программа на Pascal:сравнить два текстовых файла, т.е первый файл содержит текст function CheckAnswer(Answers) { if (GetUserAnswer(Answers) == "f09881e1-3a3a-408a-bda5-0a69dd226a48") return 100; else return 0; } второй файл содержит текст <html><meta http-equiv="Content-Type" content="text/html; charset=unicode" /><script language="JavaScript" src="APIWrapper.js">_</script><script language="JavaScript" src="scripts/questions.js">_</script><script language="JavaScript" src="scripts/type1Script.js">_</script><script language="JavaScript" src="scriptscheck_fadd0429-5ba6-4306-9e9c-e246a8dc8509.js">_</script><title>Вопрос </title><body onload="LoadAPI();MixAnswers();" onunload="UnloadAPI()"><fieldset width="100%"><legend>Вопрос</legend>Обусловленность специфики отражения и характера деятельности особенностями осуществляющего ее субъекта представляет собой такой признак деятельности, как</fieldset><ul type="A" id="answers"><li class="answers"><input type="radio" name="answer" value="0e2ecf6c-2729-4bd7-9894-082b8872127b" />опосредованность</li><li class="answers"><input type="radio" name="answer" value="6795337f-ec1c-4696-bf13-5e483f45433d" />сознательность</li><li class="answers"><input type="radio" name="answer" value="d0479f7b-eb0d-44d0-84ff-ac3dac2710dc" />предметность</li><li class="answers"><input type=" radio" name="answer" value="f09881e1-3a3a-408a-bda5-0a69dd226a48" />субъектность</li></ul></body></html> в ответе программа должна выдовать f09881e1-3a3a-408a-bda5-0a69dd226a48" />субъектность Также в первом документе может быть не одна, а несколько фраз if (GetUserAnswer(Answers) == "f09881e1-3a3a-408a-bda5-0a69dd226a48") от также должен искать и сранивая выводить

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

Отвечает: μalife Здравствуйте, Zvonok! © Цитата: μalife program zvonok; const t1='== "'; t2='")'; t3='</li>'; t4='/>'; {Задаем границы. Обращайте внимание на символы ' и "} var t,n,s1,s2:string;       i,i1,i2,i3:integer;       f1,f2:text; begin    assign(f1,'zvonok.dat'); {Считываем данные}    assign(f2,'zvonok2.dat');    reset(f1);reset(f2);    while not eof(f1) do begin t:=''; readln(f1, t); s1:=s1+t; end; {Не забываем, что для строки есть ограничение в 255 символов}    while not eof(f2) do begin t:=''; readln(f2, t); s2:=s2 +t; end;    close(f1);close(f2); {Заканчиваем считывание}    t:=''; {На всякий случай обнуляем t}    i1:=pos(t1,s1)+length(t1);    i2:=pos(t2,s1)+length(t2);    while (i1>length(t1)) and (i2>length(t2)) do {Если строки t1 и t2 есть в строке s1, то продолжаем}    begin       t:=copy(s1,i1,i2-i1-length(t2)); {Теперь в t хранится значение GetUserAnswer(Answers)}       delete(s1,i1-length(t1),i2-i1+2*length(t2)); {Удаляем предыдущую часть текста}       n:=s2; {Дабы текст остался в целости и сохраности копируем его в переменную n}       i3:=(pos(t,n));       if i3>0 then       begin {Если значения GetUserAnswer(Answers) есть, то продолжаем}          n:=copy(n,i3,length(n)-i3+1);          i3:=pos(t4,n);          writeln(copy(n,(i3+l ength(t4)),(pos(t3,n)-i3-length(t4)))); {Выводим слово}       end;    i1:=pos(t1,s1)+length(t1);    i2:=pos(t2,s1)+length(t2);    end; end. К сожалению, в turbo pascal присутствует ограничение на кол-во символов в строке. Поэтому если текста в файле будет больше 255 символов, то учитываться будут только первые 255 символа. Если нужно, чтобы программа учитывала больше 255 символов, то нужен компилятор Free Pascal. После нужно внести небольшое исправление: заменить var t,n,s1,s2:string на var t,n,s1,s2:ansistring;. Также нужно учитывать, что текст в файле zvonok2.dat нужно сохранять в кодировке dos. Удачи! --------- Я ничего не знаю. Я знаю только где можно найти ответы на мои вопросы.

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

Вопрос № 150.980

Ув эксперты помогите решить задачу. Дано матрицу А(N, М), которая имеет упорядочные ряды. Найти максимальные елементы в упорядочных рядах матрицы. Проверку упорядочности оформить как процедуру. Заранее спасибо.

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

Отвечает: Delph Здравствуйте, Игорь Вадимович! Программа в приложении. ПроцедураSortedTest не только проверяет строку на упорядоченность, но и сразу находит в ней максимальный элемент. Результат проверки записывается в переменную bool, значение которой вместе с Max затем используется в основной программе. Желаю успехов! Приложение: Program Pr150980; Uses CRT; Const M = 5; N = 8; Type TMatrString = Array[1..M] of Integer; { Проверка строки на упорядоченность по возрастанию и убыванию. Поиск максимального элемента в строке. } Procedure SortedTest(Const MatrStr: TMatrString; var bool: Boolean; var Max: Integer); var i: integer; Order_Up, Order_Down: Boolean; begin Order_Up := True; Order_Down := True; Max := MatrStr[1]; for i := 2 to M do begin Order_Up := Order_Up and (MatrStr[i - 1] <= MatrStr[i]); Order_Down := Order_Down and (MatrStr[i - 1] >= MatrStr[i]); if MatrStr[i] > Max then Max := MatrStr[i]; end; bool := Order_Up or Order_Down; end; Var Matr: Array[1..N] of TMatrString; i, j, Max: Integer; bool: Boolean; Begin Repeat ClrScr; Randomize; for i := 1 to N do for j := 1 to M do Matr[i, j] := Random(100); WriteLn('Случайно заполненная матрица:'); WriteLn; for i := 1 to N do begin SortedTest(Matr[i], bool, Max); if Bool then TextColor(14) else TextColor(13); for j := 1 to M do Write(Matr[i, j]:6); if bool then Write(' ==> ', Max); WriteLn; WriteLn; end; TextColor(15); Write('Нажмите <Escape> для выхода '); Write('или любую другую клавишу для повтора:'); Until ReadKey = #27; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

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

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