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

Выпуск № 606
от 18.03.2008, 19:35

Вопрос № 127.016

Уважаемые эксперты, требуется ваша помощь и понимание. В среде турбо паскаль мне необходимо решить задачу: Вычислить приближенное значение бесконечной суммы (справа от суммы дается ее точное значение, с которым можно сравнить полученный ответ): 1 1 1 1 П(Пи = 3, 14) (Это я так дробь _ - _ + _ - _ ........ _____ обозначил.) 1 3 5 7 4 Нужное приближение считается полученным, если вычислена сумма нескольких первых слагаемых, и очередное слагаемое оказалось по модулю меньше данного положительного числа (Эпсилон, извините вставка нормально не работает). Я вычислил формулу последовательности, но я ввожу формулы, одного типа, и мне сообщает что типы не сочетаются. Я даже не знаю что и делать. Пожалуйста помогите. Очень надеюсь на помощь.

Отправлен: 12.03.2008, 19:58 Вопрос задал: Пашков Дмитрий Владимирович (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 41)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пашков Дмитрий Владимирович! Решение вашей задачи в приложении. Комментариев не писал, так как по письму видно, что вы владеете материалом. Для интереса кроме суммы добавил вывод количества слагаемых. Приложение: uses crt; var a:array[1..200]of real; i:integer; e,sum:real; begin clrscr; write('e=');readln(e); sum:=0;i:=0; repeat i:=i+1; a[i]:=1/(2*i-1); if i mod 2<>0 then begin sum:=sum+a[i]; end else if i mod 2=0 then begin sum:=sum-a[i]; end; until abs(a[i])<e; writeln('Summa=',sum:12:10); writeln('i=',i); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 12.03.2008, 22:39 Оценка за ответ: 4 Комментарий оценки: Пупорев Юрий Борисович, спасибо, у вас хороший ответ. Но не компактный, более сложный код...

Отвечает: Verena Здравствуйте, Пашков Дмитрий Владимирович! Публикую ответ из мини-форума для рассылки. Добавила комментарии. Приложение: program LW6V16; uses crt; var s,e,b:real; n,i,k:integer; begin textbackground(green); clrscr; writeln('Введите Эпсилон'); readln(e); s:=0; {Сначала сумма равна 0} k:= -1; {Коэффициент = -1 (первый член вычитается)} n:= 1; {Чтобы на второй итерации получить 3, начинаем с 1} b:= 1; {Переменная для хранения нового члена (первый член = 1)} while (abs (b)>e) do {Условие точности} begin s:= s+b; {Добавляем новый член к сумме} n:= n+2; {Досчитываем значенатель (идём по нечётным числам)} b:= k/n; {Получаем следующий член} k:= -k; {Меняем коэффициент (знак) на противоположный} end; writeln (s, '=', 3.14/4); {Вывод результата} readln; end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 12.03.2008, 22:50 Оценка за ответ: 5 Комментарий оценки: Спасибо большое

Отвечает: Зенченко Константин Николаевич Здравствуйте, Пашков Дмитрий Владимирович! Программа в приложении. Удачи! Приложение: var a,b,e,s:real; begin write('E:');readln(e); a:=1;{начальные значения} b:=1; s:=0; {повторяем пока приращение больше эпсилон} while abs(b)>e do begin s:=s+b;{суммируем} a:=a+2;{следующее значение делителя} b:=-b/(a*abs(b));{следующее приращение} writeln(s,b:20:10);{только контроль} end; writeln('Summa:',s); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 127.081

У важаемые эксперты, я вновь прибегаю к вашей помощи, помогите пожалуйста!!! Решите данные задачки: 1.В библиотеке для каждого заказывающего книгу читателя заполняется карточка: фамилия, дата заказа, дата выдачи книги.Определить: кто чаще всего берет книги. 2.Организовать текстовый файл f состоящий из N строк. После этого организовать файлы h и g. В файл h записать строки файла f занимающие не-чётные позиции, в файл g чётные. Умоляю, помогите!!! Зарание СПАСИБО!!!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Kristi_ag! Привожу решение второй задачи. В директории BIN создаете текстовый файл любого содержания, состоящий из нескольких строк. Затем в программе инициализируете этот файл, открываете для чтения и считываете его построчно в массив строк, считая заодно количество этих строк. Затем инициализируете еще два файла, открываете их для записи. В цикле записываете четные строки в один файл, нечетные - в другой. Код в приложении. По первой задаче мне не нравится условие, какое-то оно неопределенное. Если есть дата заказа и дата выдачи, то напрашивается вопрос, кто быстрее забирает книгу. А кто чаще, то сколько кому мы напишем, столько и будет. Приложение: uses crt; var f,h,g:text; s:array[1..100]of string; n,i:integer; begin clrscr; assign(f,'file_ob.txt'); reset(f); n:=1; while not eof(f) do begin readln(f,s[n]); n:=n+1; end; close(f); assign(h,'file_ncht.txt'); rewrite(h); assign(g,'file_cht.txt'); rewrite(g); for i:=1 to n do begin if i mod 2<>0 then writeln(h,s[i]) else if i mod 2=0 then writeln(g,s[i]); end; close(h); close(g); end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 13.03.2008, 09:10 Оценка за ответ: 5 Комментарий оценки: Уважаемый Юрий Борисович, огромное Вам спасибо! На следущей паре попытаюсь ее сдать(я уверенноа она пройдет!!)! Спасибо!!

Отвечает: Костя Симанович Здравствуйте, Kristi_ag! Привожу решение второй задачи, вы сперва заполняете файл данными для наглядности можно цифрами от 1 до 9, потом программа выводит основной файл и два отсортированных. Впринципе вывод файлов можно убрать в процедуру, но я оставил так для наглядности. Решение в приложении. Приложение: program zadacha4; var f, g, h : text; i : integer; named : string; begin assign(f, 'osn.txt'); assign(g, 'p1.txt'); assign(h, 'p2.txt'); rewrite(f); writeln('Введите строку (или 0 для завершения).'); readln(named); while named <> '0' do begin writeln(f, named); writeln('Введите строку (или 0 для завершения).'); readln(named); end; close(f); {---------------Файл записан начнём обработку------------------} reset(f); // открываем файл f для чтения rewrite(g); // для записи rewrite(h); i := 1; while not EOF(f) do begin readln(f, named); // функция frac возвращает дробную часть числа // если i четное то при делении на 2 остаток = 0 if frac(i/2) = 0 then writeln(h, named) else writeln(g, named); i := i + 1; end; close(f); close(h); close(g); {-----------записаны оба файла выводим результат----------} reset(f); Reset(g); reset(h); writeln('Основной файл'); while not eof(f) do begin readln(f, named); writeln(named); end; writeln('Нечетные строки.'); while not eof(g) do begin readln(g, named); writeln(named); end; writeln('Чётные строки.'); while not eof(h) do begin readln(h, named); writeln(named); end; close(f); close(h); close(g); writeln('Для продолжения нажмте ENTER..'); readln; end.

Ответ отправил: Костя Симанович (статус: 2-ой класс) Ответ отправлен: 13.03.2008, 10:51

Вопрос № 127.090

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

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

Отвечает: Denisss Здравствуйте, Щербаков Евгений Николаевич! В приложении 1 пример, но в 2-х кодировках: cp1251 и cp866. cp1251 (или Windows-1251) - если сохранять будете с помощью блокнота, умеющего сохранять в кодировке cp866. Да и чтобы можно было нормально посмотреть на пример. cp866 - если будете сохранять в обычном блокноте. Сохранять нужно в любом случае в кодировке cp866, т.к. в DOS используется именно эта кодировка для отображения символов кириллицы. Пример полностью закомментирован. Удачи! Приложение: ################# 1251 ################# program q127090; uses Crt; const rusLetters: set of Char = ['А'..'Я', 'а'..'п', 'р'..'я', 'Ё', 'ё']; rusVowels: set of Char = ['А', 'Е', 'Ё', 'И', 'О', 'У', 'Ы', 'Э', 'Ю', 'Я', 'а', 'е', 'ё', 'и', 'о', 'у', 'ы', 'э', 'ю', 'я']; var aStr: String; maxVCount, curVCount: Byte; mxStart, mxEnd: Byte; curStart: Byte; i: Byte; t: Char; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Введите предложение:'); ReadLn(aStr); {Инициализация} maxVCount:= 0; curVCount:= 0; mxStart:= 0; mxEnd:= 0; curStart:= 1; {Перебор строки по символам} for i:= 1 to Length(aStr) do begin {Проверяем, является ли текущий символ буквой кириллицы} if not (aStr[i] in rusLetters) then begin {Проверяем, не имеет ли предыдущее слово максимальное количество гласных} if (maxVCount < curVCount) then begin {Запоминаем новое слово} mxStart:= curStart; mxEnd:= Pred(i); maxVCount:= curVCount; end; {Обнуляем счетчик} curVCount:= 0; {Запоминаем стартовую позицию нового слова} curStart:= Succ(i); end {Проверяем, является ли текущий символ гласной буквой} else if (aStr[i] in rusVowels) then {Увеличиваем счетчик} Inc(curVCount); end; {На случай, если пользователь забыл поставить знак препинания в конце предложения (например, точку).} if (maxVCount < curVCount) then begin mxStart:= curStart; mxEnd:= Length(aStr); maxVCount:= curVCount; end; {Выполняем преобразование} {Меняем местами первую и последнюю буквы} t:= aStr[mxStart]; aStr[mxStart]:= aStr[mxEnd]; aStr[mxEnd]:= t; Inc(mxStart); Dec(mxEnd); {Меняем местами вторую и предпоследнюю буквы} t:= aStr[mxStart]; aStr[mxStart]:= aStr[mxEnd]; aStr[mxEnd]:= t; {Вывод результата} WriteLn('Результат:'); WriteLn(aStr); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end. ################# 866 ################# program q127090; uses Crt; const rusLetters: set of Char = ['Ђ'..'џ', ' '..'Ї', 'а'..'п', 'р', 'с']; rusVowels: set of Char = ['Ђ', '…', 'р', '€', 'Ћ', '“', '›', 'ќ', 'ћ', 'џ', ' ', 'Ґ', 'с', 'Ё', '®', 'г', 'л', 'н', 'о', 'п']; var aStr: String; maxVCount, curVCount: Byte; mxStart, mxEnd: Byte; curStart: Byte; i: Byte; t: Char; begin {ЋзЁбвЄ  нЄа ­ } ClrScr; {‚ў®¤ бва®ЄЁ} writeln('‚ўҐ¤ЁвҐ ЇаҐ¤«®¦Ґ­ЁҐ:'); ReadLn(aStr); {€­ЁжЁ «Ё§ жЁп} maxVCount:= 0; curVCount:= 0; mxStart:= 0; mxEnd:= 0; curStart:= 1; {ЏҐаҐЎ®а бва®ЄЁ Ї® бЁ¬ў®« ¬} for i:= 1 to Length(aStr) do begin {Џа®ўҐа塞, пў«пҐвбп «Ё ⥪гйЁ© бЁ¬ў®« ЎгЄў®© ЄЁаЁ««Ёжл} if not (aStr[i] in rusLetters) then begin {Џа®ўҐа塞, ­Ґ Ё¬ҐҐв «Ё ЇаҐ¤л¤г饥 б«®ў® ¬ ЄбЁ¬ «м­®Ґ Є®«ЁзҐбвў® Ј« б­ле} if (maxVCount < curVCount) then begin {‡ Ї®¬Ё­ Ґ¬ ­®ў®Ґ б«®ў®} mxStart:= curStart; mxEnd:= Pred(i); maxVCount:= curVCount; end; {ЋЎ­г«пҐ¬ бзҐвзЁЄ} curVCount:= 0; {‡ Ї®¬Ё­ Ґ¬ бв ав®ўго Ї®§ЁжЁо ­®ў®Ј® б«®ў } curStart:= Succ(i); end {Џа®ўҐа塞, пў«пҐвбп «Ё ⥪гйЁ© бЁ¬ў®« Ј« б­®© ЎгЄў®©} else if (aStr[i] in rusVowels) then {“ўҐ«ЁзЁў Ґ¬ бзҐвзЁЄ} Inc(curVCount); end; {Ќ  б«гз ©, Ґб«Ё Ї®«м§®ў вҐ«м § Ўл« Ї®бв ўЁвм §­ Є ЇаҐЇЁ­ ­Ёп ў Є®­жҐ ЇаҐ¤«®¦Ґ­Ёп (­ ЇаЁ¬Ґа, в®зЄг).} if (maxVCount < curVCount) then begin mxStart:= curStart; mxEnd:= Length(aStr); maxVCount:= curVCount; end; {‚лЇ®«­пҐ¬ ЇаҐ®Ўа §®ў ­ЁҐ} {ЊҐ­пҐ¬ ¬Ґбв ¬Ё ЇҐаўго Ё Ї®б«Ґ¤­оо ЎгЄўл} t:= aStr[mxStart]; aStr[mxStart]:= aStr[mxEnd]; aStr[mxEnd]:= t; Inc(mxStart); Dec(mxEnd); {ЊҐ­пҐ¬ ¬Ґбв ¬Ё ўв®аго Ё ЇаҐ¤Ї®б«Ґ¤­оо ЎгЄўл} t:= aStr[mxStart]; aStr[mxStart]:= aStr[mxEnd]; aStr[mxEnd]:= t; {‚лў®¤ १г«мв в } WriteLn('ђҐ§г«мв в:'); WriteLn(aStr); {Ћ¦Ё¤ ­ЁҐ ­ ¦ вЁп Ї®«м§®ў вҐ«Ґ¬ «оЎ®© Є­®ЇЄЁ} WriteLn; WriteLn('Press any key...'); ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 13.03.2008, 11:31 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Поскольку не оговорены разделители слов в предложении и прочие знаки препинания, считаем, что слова разделены пробелами. Исходя из этого составлена моя программа, смотрите ее в приложении. Приложение: program q127090; uses crt; const glm=['а','е','ё','и','о','у','ы','э','ю','я'];//множество гласных маленьких glb=['А','Е','Ё','И','О','У,'Э','Ю','Я']; //и больших, чтобы строки поменьше var s:string;x:char; s1:array[1..50]of string; //массив слов b:array[1..10]of byte; //массив количеств гласных в словах i,j,k,g,max,imax:integer; begin clrscr; write('s: ');readln(s); j:=1; for i:=length(s) downto 1 do if s[i]=' 'then begin s1[j]:=copy(s,1,(pos(' ',s)-1));//создаем массив слов delete(s,1,pos(' ',s)); j:=j+1; end; s1[j]:=s; //последнее слово g:=0; for i:=1 to j do begin for k:=1 to length(s[i]) do if (s1[i][k] in glm)or(s1[i][k] in glb) then begin g:=g+1; //считаем гласные в словах end; b[i]:=g; //и создаем массив количеста end; max:=b[1];imax:=1; for i:=2 to j do if b[i]>max then //находим слово с наибольшим количеством гласных begin max:=b[i]; imax:=i; end; for i:=1 to 2 do //переставляем буквы по условию begin x:=s1[imax][i];s1[imax][i]:=s1[imax][length(s1[imax])-i+1]; s1[imax][length(s1[imax])-i+1]:=x; end; writeln(s1[imax]); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 13.03.2008, 12:45 Оценка за ответ: 4

Вопрос № 127.134

Народ, помогите пожалуйста, я в информатике полный ноль, а тройку уж очень не хочется. Задачи для умных людей наверное несложные..вот: 1. В каталоге содержаться сведения о каждой из книг: фамилия автора, название, издательство и год издания. a. Найти названия книг данного автора, изданных с 1985 г.; b. Определить, имеется ли книга в названии которой есть слово "информатика". Если да, то сообщить фамилию автора и год издания. Если таких книг несколько, то сообщить имеющиеся сведения обо всех этих книгах; c. Вывести книги указанного издательства за введенный год издания. * к программе меню вывести через кейс 1. показать все 2. a 3. b 4. c 5. выход 2. В заданном тексте удалить часть текста , заключенную в скобки (вместе со скобками) 3. Задан текст, содержащий не более 255 символов. Определить, сколько раз в тексте встречаются различные буквы латинского алфавита

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

Отвечает: Verena Здравствуйте, Natasha1993! В приложении первая задача и третья. В первой я написала в меню русской раскладке, при копировании в Паскаль скорее свего попортится кодировка, не забудьте исправить. В третьей задаче не очень понятное условие, как я поняла, надо посчитать количество различных символов в строке, с этим условием я и решила. Касательно второй задачи - посмотрите вопрос 125903, там уже обсуждалась такая задача. Удачи! Приложение: {Задача 1} uses crt; Type Book = record {Запись, описывающая книгу} title: string[20]; {Заголовок} auname: string[20]; {Автор} publ: string[20]; {Издательство} year: word; {Год} end; cat = array [1..100] of book; {Тип - каталог книг} procedure SearchByAuthor (auname: string; year: word; var a: cat; n: integer); {Поиск книг автора с определённого года} Var i: integer; Begin for i:=1 to n do if (auname=a[i].auname) and (a[i].year>=year) then writeln (a[i].title); end; procedure SearchByWord (word: string; var a: cat; n: integer); {Поиск книг по слову в названии} Var i: integer; Begin for i:=1 to n do if (pos (a[i].title, word)<>0) then writeln (a[i].title:20, ':', a[i].auname:20, a[i].year:5); end; procedure SearchByPubl (publ: string; year: word; var a: cat; n: integer); {Поиск книг по издательству и году издания} Var i: integer; Begin for i:=1 to n do if (a[i].publ=publ) and (a[i].year=year) then writeln (a[i].title); end; procedure PrintAllInfo (var a: cat; n: integer); {Вывести всё} Var i: integer; Begin for i:=1 to n do writeln (a[i].auname:20, a[i].title: 20, a[i].publ:20, a[i].year:5); end; procedure EnterInfo (var a: cat; var n: integer); {Ввод информации} Var i: integer; Begin writeln ('Введите размерность: '); readln (n); for i:=1 to n do begin writeln ('Автор:'); readln (a[i].auname); writeln ('Заголовок:'); readln (a[i].title); writeln ('Издательство:'); readln (a[i].publ); writeln ('Год:'); readln (a[i].year); end; end; Var a: cat; n, i, v: integer; tmp: string; y: word; Begin clrscr; EnterInfo (a, n); {Вводим информацию} v:=-1; while (v<>5) do {Пока не выбран выход} begin clrscr; {Очистка экрана} writeln ('1. Показать всё'); writeln ('2. Найти названия книг данного автора, изданных с 1985 г.'); writeln ('3. Определить, имеется ли книга в названии которой есть слово "информатика".'); writeln ('4. Вывести книги указанного издательства за введенный год издания.'); writeln ('5. Выход'); writeln ('Выберите пункт: '); readln (v); case v of {Реализация меню} 1: begin PrintAllInfo (a, n); readkey; {Ожидание клавиши} end; 2: begin readln (tmp); SearchByAuthor (tmp, 1985, a, n); readkey; end; 3: begin SearchByWord ('информатика', a, n); readkey; end; 4: begin readln (tmp); readln (y); SearchByPubl (tmp, y, a, n); readkey; end; 5: begin end; else writeln ('Неверный выбор'); end; end; end. {Задача 2} Var s, buf1: string; k, i, l: integer; Begin readln (s); l:= length(s); k:= 0; for i:=1 to l do begin buf1:= copy (s, 0, i-1); {Копируем в дополнительную переменную часть до символа} if (pos (s[i], buf1)=0) then inc (k); {Если раньше символ не попадался - надо его посчитать} end; writeln (k); end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 17.03.2008, 22:00

Вопрос № 127.179

Уважаемые эксперты! Напишите программу: 1.Заполнить массив случайными целыми числами и найти произведение наименьших цифр нечетных его элементов? 2.Заполнить массив случайными целыми числами и найти произведение наибольших цифр его элементов?

Отправлен: 13.03.2008, 17:42 Вопрос задал: Papan (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Papan! В обеих задачах применим стандартный алгоритм разбиения числа на цифры: 1. Сохраняем в отдельной переменной остаток от деления числа на 10 (это последняя его цифра). 2. Само число целочисленно делим на 10, т.е. отбрасываем его последнюю цифру. 3. Если число стало равным нулю - выходим из цикла. В противном случае возвращаемся к шагу 1. Только в применении к данным задачам, мы ещё будем на каждой итерации сравнивать новую полученную цифру с переменной, хранящей минимальную (максимальную) на данный момент цифру. Обратите внимание, что в первой задаче произвдение почти всегда будет равно нулю, поскольку массив заполняется случайными числами, в которых могут попадаться нули, а ноль всегда будет минимальной цифрой числа, и один ноль в качестве множителя будет обращать в ноль всё произведение. Думаю, из комментариев всё будет ясно. Удачи! Приложение: Const n = 10; Type mas = array [1..n] of integer; Var i: integer; pr: longint; a: mas; function MinTz (a: integer): integer; {Функция нахождения минимальной цифры числа} Var min, t: integer; begin min:= a mod 10; {Берём последнюю цифру за минимальную} a:= a div 10; {Обрезаем число} while (a>0) do {Пока число не обнулится} begin t:= a mod 10; {Полычаем следующую цифру} if (t<min) then min:= t; {Если она меньше - пересохраняем} a:= a div 10; {Обрезаем число} end; MinTz:= min; {Возвращаем результат} end; function MaxTz (a: integer): integer; {Функция нахождения максимальной цифры числа} Var max, t: integer; {Здесь всё аналогично предыдущей функции, кроме одного условия в while} begin max:= a mod 10; a:= a div 10; while (a>0) do begin t:= a mod 10; if (t>max) then max:= t; {Здесь - если больше} a:= a div 10; end; MaxTz:= max; end; begin randomize; {Инициализируем генератор случайных чисел} for i:=1 to n do a[i]:= random (5000); {Заполняем массив случайными числами в пределах от 0 до 5000} writeln ('Massiv: '); {Выводим полученный массив} for i:=1 to n do write (a[i]:7); writeln; i:=1; pr:=1; while (i<=n) do {До конца массива} begin pr:= pr*MinTz (a[i]); {Домножаем произведение на минимальную цифру очередного элемента массива } inc (i, 2); {Переходим к следующему нечётному элементу} end; writeln ('Произведение минимальных цифр нечётных элементов: ', pr); {Выводим результат} pr:= 1; {Теперь посчитаем произведение максимальных цифр} for i:=1 to n do pr:= pr*MaxTz (a[i]);{Домножаем произведение на максимальную цифру очередного элемента массива } writeln ('Произведение максимальных цифр всех элементов: ', pr); {Выводим результат} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 13.03.2008, 18:13 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Papan! Я объединил обе задачи в одну. Функции немного корявые получились, хотя все работает. Кто-нибудь наверняка лучшее решение предложит. Код с пояснениями в приложении. Приложение: program cifra; uses crt; var n,P1,P2:longint;min,max:byte;i:integer; a:array[1..50]of longint; function mincif(n:longint):byte;//находит минимальную цифру var a,i,u:integer; b:array[1..7] of integer; begin a:=0; while n>0 do begin u:=n mod 10; a:=a+1; b[a]:=u; n:=n div 10; end; min:=b[1]; for i:=1 to a do if b[i]<min then min:=b[i]; mincif:=min; end; function maxcif(n:longint):byte;//находит максимальную цифру var max:integer; var a,i,u:integer; b:array[1..7] of integer; begin a:=0; while n>0 do begin u:=n mod 10; a:=a+1; b[a]:=u; n:=n div 10; end; max:=b[1]; for i:=1 to a do if b[i]>max then max:=b[i]; maxcif:=max; end; begin //начало программы clrscr; randomize; write('n=');readln(n); for i:=1 to n do begin a[i]:=random(10000)+5000; write(a[i],' '); end; P1:=1; for i:=1 to n do if i mod 2<>0 then //нечетные элементы begin P1:=P1*mincif(a[i]);//произведение минимальных цифр end; P2:=1; for i:=1 to n do P2:=P2*maxcif(a[i]); //произведение максимальных цифр write('P1=',P1,' P2=',P2); readln; end.

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

Вопрос № 127.183

Здравствуйте, прошу помочь с задачей: Заданы три матрицы A,B и С. Найти минимальное из трех чисел x,y,z где x след матрицы А, y след матрицы В, z след матрицы С (След матрицы называется сумма элементов главной диагонали). Использовать Function. Значения матриц: type А=array [1..3, 1..3] of real; type В=array [1..2, 1..2] of real; type С=array [1..3, 1..3] of real; const t=((1,2,3),(4,5.1,6),(7,8,9)); k=((25,7),(8,9)); s=((3,4,8.2),(7,1,2),(6,5,8)); Заранее благодарю всеx за ответы и если можно до утра…

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

Отвечает: Verena Здравствуйте, Name! Для объявления параметров функции выбрала тип А, поскольку он включает в себя тив В (а с типом С вообще эквивалентен). Поскольку константы с массивами разнотиповые, передать их в одну функцию не получается - я переписываю их в отдельный массив. Решение в приложении. Удачи! Приложение: const r1 = 3; r2 = 2; type A=array [1..r1, 1..r1] of real; B=array [1..r2, 1..r2] of real; C=array [1..r1, 1..r1] of real; const t:A= ((1,2,3),(4,5.1,6),(7,8,9)); k:B= ((25,7),(8,9)); s:C= ((3,4,8.2),(7,1,2),(6,5,8)); var mas: A; i, j: integer; min, tmp: real; function Sled (var mas: A; n: integer): real; Var sm: real; i: integer; begin sm:= 0; {Сумма сначала равна нулю} for i:=1 to n do {На каждой итерации её досчитываем} sm:= sm+mas[i, i]; {Элементы главной диагонали имеют равные индексы} Sled:= sm; {Возвращаем результат} end; Begin for i:=1 to r1 do for j:=1 to r1 do mas[i,j]:= t[i,j]; min:= Sled (mas, r1); {Минимальное пока равно следу первой матрицы} writeln ('Sled v t: ', min:3:3); for i:=1 to r2 do for j:=1 to r2 do mas[i,j]:= k[i,j]; tmp:= Sled (mas, r2); if (tmp<min) then min:= tmp; {Если след второй меньше - перезаписываем} writeln ('Sled v k: ', tmp:3:3); for i:=1 to r1 do for j:=1 to r1 do mas[i,j]:= s[i,j]; tmp:= Sled (mas, r1); if (tmp<min) then min:= tmp; {Если след третьей меньше - перезаписываем} writeln ('Sled v s: ', tmp:3:3); writeln ('Minimalnoe iz nih: ', min:3:3); {Выводим результат} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 13.03.2008, 18:49 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Name! Написал вашу программу, проверьте только числа, а то от них в глазах рябит, мог и ошибиться. Решение в приложении. Приложение: uses crt; type matr=array[1..10,1..10]of real; var a,b,c:matr; x,y,z,minch:real; function Sled(n:integer;a:matr):real; //ф-я ищет след var sum:real;i,j:integer; begin sum:=0; for i:=1 to n do for j:=1 to n do if i=j then begin sum:=sum+a[i,j]; end; Sled:=sum; end; function Min3(x,y,z:real):real;//ф-я находит минимальное var min:real; begin if (x<y)and(x<z)then min:=x else if (y<x)and(y<z)then min:=y else if (z<y)and(z<x)then min:=z; Min3:=min; end; begin clrscr; a[1,1]:=1; a[1,2]:=2;a[1,3]:=3; a[2,1]:=4; a[2,2]:=5.1;a[2,3]:=6; a[3,1]:=7; a[3,2]:=8;a[3,3]:=9; b[1,1]:=25; b[1,2]:=7; b[2,1]:=8; b[2,2]:=9; c[1,1]:=3; c[1,2]:=4;c[1,3]:=8.2; c[2,1]:=7; c[2,2]:=1;c[2,3]:=2; c[3,1]:=6; c[3,2]:=5;c[3,3]:=8; x:=Sled(3,a); //находим три следа y:=Sled(2,b); z:=Sled(3,c); minch:=Min3(x,y,z); //находим наименьшее write('Minimum=',minch:4:2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 13.03.2008, 20:21 Оценка за ответ: 5 Комментарий оценки: Спасибо большое

Вопрос № 127.190

Уважаемые эксперты помогите пожалуйста решить задачи буду вам Оооочень благодарна! 1)Дан целочисленный массив с количеством элементов n, сжать массив, выбросив из него каждый второй элемент. Примечание: дополнительный массив не использовать. 2)Дана действительная квадратная матрица порядка N (N-нечетное), все элементы которой различны. Найти наибольший элементы среди стоящих на главной и побочной диагоналях и поменять его местами этих диагоналей. Единственная просьба решите пожалуйста попроще,т.к. я учусь в техническом учреждении могут не поверить) Заранее БОЛЬШОЕ СПАСИБО!!!

Отправлен: 13.03.2008, 18:37 Вопрос задала: Нуруллина Светлана Азатовна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Нуруллина Светлана Азатовна! Решение первой задачи с пояснениями в приложении. К сожалению проще нельзя. Второе задание, извините, не понял. Приложение: uses crt; var a:array[1..50]of integer;//массив чисел n,i,j:integer; begin clrscr; //очищаем экран write('n=');readln(n);//вводим размерность массива for i:=1 to n do begin a[i]:=i; //наполняем массив порядковыми write(a[i],' '); //числами для наглядности end; writeln; j:=1; repeat j:=j+1; //начиная со второго элемента до предпоследнего for i:=j to (n-j+1) do //сдвигаем все элементы влево begin //второй раз начиная с третьего до предпоследнего и так до (n div 2) +1; ] a[i]:=a[i+1]; end; until j=(n div 2) +1; if n mod 2=0 then //если количество элементов четное begin for i:=1 to (n div 2) do //выводим от 1 до (n div 2) write(a[i],' '); end else if n mod 2=1 then //если количество элементов нечетное begin for i:=1 to (n div 2)+1 do //выводим от 1 до (n div 2)+1; write(a[i],' '); end; readln end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Нуруллина Светлана Азатовна! Обе задачи выполняются последовательно. Вопросы по программам задавайте в мини-форум. Удачи! Приложение: uses crt;{этот модуль подключен только для подсвеки диагоналей} const n=9; var a:array[1..n]of integer; b:array[1..n,1..n]of real; c:real; i,j,z:integer; begin {первая задача} writeln('Задача I'); randomize; {генерируем массив} for i:=1 to n do begin {генерируем элемент массива и выводим его} a[i]:=random(99); write(a[i]:4); end; writeln; j:=1; while(2*j-1)<=n do begin {перебираем массив и все нечетные элементы смещаем в начало} a[j]:=a[2*j-1]; {выводим смещенный элемент} write(a[j]:4); inc(j); end; readln; {Вторая задача} writeln('Задача II'); for i:=1 to n do begin for j:=1 to n do begin {генерируем случайное число} b[i,j]:=random(100)/(random(1000)+1); {только для подсветки диагоналей} if (i=j)or(i=(n-j+1)) then TextColor(15); {выводим значение элемента массива} write(b[i,j]:8:4); {только для подсветки диагоналей} TextColor(7); end; writeln; end; {индексы наиболших элементов диагоналей} i:=1; j:=1; {поиск наибольших элементов диагоналей} for z:=1 to n do begin {проверяем главную диагональ} if b[z,z]>b[i,i] then i:=z; {проверяем побочную диагональ} if b[z,n-z+1]=b[j,n-j+1]then j:=z; end; {меняем местами} c:=b[i,i]; b[i,i]:=b[j,n-j+1]; b[j,n-j+1]:=c; {выводим результат} writeln; for i:=1 to n do begin for j:=1 to n do begin {только для подсветки диагоналей} if (i=j)or(i=n-j+1) then TextColor(15); {вывод значения элемента массива} write(b[i,j]:8:4); {только для подсветки диагоналей} TextColor(7); end; writeln; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

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