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

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

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

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

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

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

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

Выпуск № 766
от 26.12.2008, 11:35

Вопрос № 155074: Определить, какое из двух слов длиннее и на сколько....

Вопр ос № 155.074

Определить, какое из двух слов длиннее и на сколько.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Держите уж Ваш код! Приложение: uses crt; var s,s1:string; l,l1,dl:byte; begin clrscr; write('Vvedite 1 slovo: ');readln(s); write('Vvedite 2 slovo: ');readln(s1); l:=length(s);l1:=length(s1); if l>l1 then writeln('Slovo 1 dlinnee na ',l-l1,' bukv!') else if l1>l then writeln('Slovo 2 dlinnee na ',l1-l,' bukv!') else if l=l1 then writeln('Dliny slov ravny!'); readln end.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Вот вариант решения вашей задачи Приложение: program L; var s1,s2:string; l1,l2:integer; begin write('vvedie slovo 1 :'); readln(s1); write('vvedie slovo 2 :'); readln(s2); l1:=length(s1); l2:=length(s2); writeln('Dlina slova 1 : ',l1,' simvola'); writeln('Dlina slova 2 : ',l2,' simvola'); if l1=l2 then writeln('Dlina slova 1 i slova 2 odinakova'); if l1>l2 then writeln('Slovo 1 dlinnee slova 2 na ',l1-l2,' simvola'); if l2>l1 then writeln('Slovo 2 dlinnee slova 1 na ',l2-l1,' simvola'); readln; end.

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

Вопрос № 155.077

Выяснить, можно ли из символов заданного слова составить слово "море".

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: uses crt; const m=['м,'о,'р','е'];{объявляем константу-множество из нужных символов} var s:string; {исходное слово} m1:set of char;{множество символов} i:integer; begin clrscr; write('Vvedite slovo: ');readln(s); m1:=[]; {пустое множество} for i:=1 to length(s) do if not (s[i] in m1) then m1:=m1+[s[i]];{заполняем его символами из нашего слова} if m-m1=[] then writeln ('Yes!'){если после вычитания из константы полученного множества остается пустое множество, значит эти 4 символа в заданном слове есть} else writeln('No!'); Єeadln end.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Мой вариант решения Приложение: program more; var s1,s2:string; i,j:integer; begin write('Введите исходное слово :'); readln(s1); s2:='море'; j:=1; for i:=1 to length(s2) do j:=j*pos(s2[i],s1); if j>0 then writeln('Слово "море" можно составить') else writeln('Слово "море" нельзя составить'); readln; end.

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

Вопрос № 155.078

Заменить в тексте все большие латинские буквы на маленькие.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: uses crt; var s:string; i:integer; begin clrscr; writeln('Vvedite text: '); readln(s); for i:=1 to length(s) do {если прописная, то к ее коду добавляем 32 и будет строчная} if s[i] in ['A'..'Z'] then s[i]:=chr(ord(s[i])+32); write(s); readln end.

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

Вопрос № 155.079

Оставить в данном слове из каждого набора одинаковых букв, идущих подряд, только одну букву.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: uses crt; var s:string; i:integer; begin clrscr; write('Vvedite slovo: ');readln(s); for i:=length(s) downto 2 do {смотрим слово с конца, чтоб не нарушить нумерацию символов} if s[i]=s[i-1] then delete(s,i,1); {если впереди такой же символ, удаляем текущий} write(s); readln end.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Другой вариант решения: Приложение: program Simvol; var s,s1,ss:string; i:integer; begin write('Vvedite stroky :'); readln(s); s1:=s[1]; ss:=s1; for i:=2 to length(s) do if ss<>s[i] then begin ss:=s[i]; s1:=s1+ss; end; writeln(s1); readln; end.

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

Вопрос № 155.083

Даны две целочисленные квадратные матрицы порядка 6. Найти последовательность из нулей и единиц b1, ... , b6 такую, что bi=1, когда количество отрицательных и неотрицательных элементов i - строки первой матрицы совпадает соответственно с количеством отрицательных и неотрицательных элементов i - строки второй матрицы.

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

Отвечает: Кулик Александр Сергеевич Здравствуйте, Иванов Виктор Олегович! Решение вашей задачи в приложении, все вопросы в личку. Приложение: Var a,c:array[1..6,1..6] of integer; b:array[1..6] of integer; i,j,k,k_o1,k_o2:integer; BEGIN for i:=1 to 6 do for j:=1 to 6 do a[i,j]:=random(9)-random(9); for i:=1 to 6 do for j:=1 to 6 do c[i,j]:=random(9)-random(9); for i:=1 to 6 do begin writeln; for j:=1 to 6 do write(a[i,j]:2); end; writeln; for i:=1 to 6 do begin writeln; for j:=1 to 6 do write(c[i,j]:2); end; writeln; k_o1:=0; k_o2:=0; k:=1; for i:=1 to 6 do for j:=1 to 6 do begin if a[i,j]<0 then inc(k_o1); if c[i,j]<0 then inc(k_o2); if j=6 then begin if k_o1=k_o2 then b[k]:=1 else b[k]:=0; k_o1:=0; k_o2:=0; inc(k); end; end; writeln; for i:=1 to 6 do write(b[i]:2); END. --------- нет ничего невозможного!

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

Вопрос № 155.090

Добрый день. Пожалуйста помогите срочно решить 4 задачки по программированию, или хотя бы часть из них. 1. e^x=1+x/1!+x^2/2!+x^3/3!+x^n/n!+... |x|<бесконечности 2. Ввести текст. Переставить местами слова в каждом предложении (первое с последним, второе с предпоследним и т.д.). 3. Создать файл целых чисел. Получить новый файл целых чисел, содержащий исходные числа, десятичные цифры которых записаны в обратном порядке. Рассортировать новый файл по возрастанию чисел. Приложение: Для каждого задания есть условия: 2: 1. Текст стандартного типа String ввести с клавиатуры. 2. Между словами могут быть различные разделители (пробел, запятая, точка и т.д.), которые необходимо задать во множестве. 3. Вывести исходный текст и текст после преобразования его по условию задачи. 3: при обработке файла необходимо использовать либо булевское значение функции EOF (конец файла), либо значение функции FILESIZE (размер файла). Сами значения каждой компоненты можно задавать генератором случайных чисел. Вывод исходного файла и файла с результатами сделать процедурой (и, если файлы одного типа, то одной процедурой)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Васильев Артем Сергеевич! Решение первой задачи в приложении. Комментариев нет, одна математика. Приложение: uses crt; var x,s,t:real; n,i:integer; begin clrscr; write('x=');readln(x); write('n=');readln(n); s:=1;t:=1; for i:=1 to n do begin t:=t*x/i; s:=s+t; end; writeln('S= ',s:0:8); writeln('e^x=',exp(x):0:8); readln end.

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

Вопрос № 155.110

В данном коде реализована программа вывода системной даты и времени...она работает, но не так ка хотелось бы...помогите сделать, чтоб она выводилась в следущем формате пример: 11 часов 30 минут 25 секунд 17 декабря 2008 года чтоб оканчания менялись..( 1 час 31 минута 1 секунда).. Заранее признателен.. Приложение: uses SysUtils; function Rus(mes: string):string; var i: integer; begin for i:= 1 to length(mes) do case mes[i] of 'А'..'п' : mes[i] := Chr(Ord(mes[i]) - 64); 'р'..'я' : mes[i] := Chr(Ord(mes[i]) - 16); end; rus:=mes; end; begin writeln(rus('Время: '+formatdatetime('hh часа mm минут ss секунд', time()))); writeln(rus('Дата: '+formatdatetime('dddddd', date()))); readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Angel1731! Программа в приложении. Вопросы задавайте в мини-форум. Удачи! Приложение: uses WinDos; var Hr,Mi,Se,Sm,Yr,Mo,Dt,Dw:word; {преобразовываем месяц} function isMo(z:word):string; begin case z of 1:isMo:='jan'; 2:isMo:='feb'; 3:isMo:='mar'; 4:isMo:='apr'; 5:isMo:='may'; 6:isMo:='jun'; 7:isMo:='jul'; 8:isMo:='aug'; 9:isMo:='sep'; 10:isMo:='oct'; 11:isMo:='nov'; 12:isMo:='dec'; end; end; {окончание часов} function isHr(z:word):string; begin case z of 1,21:isHr:=''; 2..4,22,23:isHr:='a'; 0,5..20:isHr:='ov'; end; end; {окончание секунд и минут} function isMS(z:word):string; begin case (z mod 10) of 0,5..9:isMS:=''; 1:isMS:='a'; 2..4:isMS:='y'; end; if (z div 10)=1 then isMs:=''{отдельно обрабатываем десятки} end; begin {получаем время и выводим результат} GetTime(Hr,Mi,Se,Sm); writeln('Time:',hr,' chas',ishr(hr),' ',mi,' minut',isMS(mi),' ',se,' secund',isMS(se)); {получаем дату и выводим результат} GetDate(Yr,Mo,Dt,Dw); Writeln('Data:',Dt,' ',isMo(Mo),' ',Yr,' years'); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 155.129

Даны натуральное число n, символы s1, ... , sn (n > 1). Преобразовать последовательность s1, ... , sn, заменив запятыми все двоеточия, встречающиеся среди s1, ... , s[n/2], и заменив точками все восклицательные знаки, встречающиеся среди s[n/2]+1, ... , sn.

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

Отвечает: Mixala Здравствуйте, Иванов Виктор Олегович! это простая задача - берется два цикла, до середины и за серединой и проверяется наличие знаков, который требуется заменить, что и происходит при нахождении. Приложение: const nmax=100; var a:array[1..nmax] of char; n,i,n2:integer; begin Read(n); For i:=1 to n do Read(a[i]); n2:=n div 2; For i:=1 to n2 do if a[i]=':' then a[i]:=','; for i:=n2+1 to n do if a[i]='!' then a[i]:='.'; For i:=1 to n do Write(a[i],' '); end.

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

Вопрос № 155.130

Даны натуральное число n, символы s1, ... , sn. Группы символов, разделенные пробелами (одним или несколькими) и не содержащие пробелов внутри себя, будем называть словами. Преобразовать данную последовательность, заменяя каждое вхождение слова это на слово то.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! Ваша задача в приложении. При данных условиях необходимо удалить только букву Э в слове это. Удачи! Приложение: var s:string; begin {вводим строку} write('Enter S1..Sn:'); readln(s); {цикл замены} while (pos(' eto',s)>0)or(pos('eto',s)=1)do delete(s,pos(' eto',s)+1,1); {выводим результат} write('Result:',s); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 155.136

Здравствуйте уважаемые эксперты вот задачи : 1.Дано натуральное число n, действительная матрица n*9. Найти среднее арифметическое каждого из столбцов. 2.Определить с помощью подпрограмм максимальные элементы в каждой строке матрицу А(5,5) целого типа.

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

Отвечает: Mixala Здравствуйте, Евсеев Андрей Максимович! писал по своему пониманию условия. в первой задаче все средние арифметические вычисляются и записываются в массив. Во второй задаче максимумы не сохраняются а сразу выводятся из вункции, куда передается вся строка. Приложение: { 1 } const nmax=100; var n,i,j:integer; a:array[1..nmax,1..9] of real; b:array[1..9] of real; //массив средних арифметических - как я понял в матрице будет 9 столбцов begin Read(n); for i:=1 to n do //матрица заполняется построчно for j:=1 to 9 do Read(a[i,j]); for i:=1 to 9 do begin b[i]:=0; for j:=1 to n do b[i]:=b[i]+a[i,j]; b[i]:=b[i] /n; For i:=1 to 9 do Write(b[i],' '); end. { 2 } type new=array[1..5] of integer; //тип одной строки function max(q:new):integer; //функция поиска максимума в строке var j,max:integer; begin max:=low(integer); //определяем максимум самым мальньким значением, чтобы любой элемент был заведомо больше его for j:=1 to 5 do if q[i]>max then max:=q[i]; result:=max; //функция выводит результат end; var a:array[1..5] of new; i,j:integer; begin //основная программа for i:=1 to 5 do For j:=1 to 5 do Read(a[j][i]); For i:=1 to 5 do Write(max(a[i]),' '); //просто выводим максимумы end.

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

Вопрос № 155.147

уважаемые эксперты помогите решить данную задачу. Задана последовательность из N вещественных чисел. Вычислить значение функции : корень N-ой степени из IX1*X2*X3*...*XNI

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Bel9illi! Решение в приложении. Понял что произведение взято по модулю. Приложение: uses crt; const nmax=100; var x:array[1..nmax]of extended; n,i:integer; p:real; begin clrscr; randomize; write('n=');readln(n); writeln('Massiv:'); p:=1.0; for i:=1 to n do begin x[i]:=10*random-3; p:=p*x[i]; {считаем произведение} write(x[i]:5:2); end; writeln; write('Koren=',exp(ln(abs(p))*(1/n)):0:4);{находим корень по формуле y=p^1/n=exp(ln(|p|)*1/n)} readln end.

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

Вопрос № 155.160

Здраствуйте, вот и наступила сессия-период сдачи долгов в учебе...в общем всем доброго времени суток и у меня вопрос состоит на этот раз из 2-х частей. 1 часть это решить задачки надо(как всегда срочно). Я не лентяй, а эти задачи лишь малая часть тех что нужно решить...поверьте. Задачи несложные просто у меня по другим предметам есть долги, на закрытие которых можно потратить все время и неуспеть программирование. 1 блок 1. пределить сколько нулей находится до мин. значения в массиве Е[1..30] 2. В матрице [1..8,1..10] переставить строки в порядку убывания количества отриц. чисел в строке 3. Вести текст пипа string и определить, сколько слов начинается и заканчивается на А. Вывести их на печать. В приложении вот там текст есть, нормально так?... 2 блок 1. В матрице А [1..6,1..9] вычислить сумму элементов находящихся правее столбца с максимальным элементом матрицы и среднее арифметическое элементов расположенных ниже строки с максимальным элемент ом матрицы 2. Подсчитать количество предложений. Расставить предложения по возрастанию количества слов в каждом И еще главный вопрос...Я решил что в каникулы обязательно достигну наивысшего уровня понимания паскаля и умения решать задачи. Посоветуйте книжку какую почитать про такие темы как: 1. Про блоксхемы побольше хочу знать 2. Посоветуйте пожалуйста лучшую книжку по основам алгоритмизации и программирования, есть предмет такой в универе, но както мало проходим а задают вещи которые мы не изучали, будто должны сами знать 3. По криптографии учебник Алферова покупать или не стоит? "Основы криптографии" называется... 4. Книга "Кнут.Исскуство программирования.т.1-3" рекомендовали на одном сайте, слу чайно увидел я...что про нее скажете? P.S. Буду рад любому высказавшемуся эксперту! Кто чтото знает пишите Приложение: в 1 блоке 3 задачка на строки: uses crt; var s,sub:string; i,n,k:integer; a:array[1..100] of string; m:real; begin clrscr; writeln('Input str'); readln(s); i:=0;n:=0; repeat inc(i); if (s[i]=' ')and(s[i+1]<>' ') then begin inc(n); a[n]:=sub; sub:=''; end else if s[i]<>' ' then sub:=sub+s[i]; until i=length(s); if sub<>'' then begin inc(n); a[n]:=sub; end; writeln; k:=0; for i:=1 to n do if (UpCase(a[i][1])=UpCase(a[i][length(a[i])]))and(UpCase(a[i][1])='A') then begin inc(k); writeln(a[i]); end; writeln(k); end.

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

Отвечает: Кулик Александр Сергеевич Здравствуйте, Сараев Лаврентий Александрович! Решение 1 задачи первого блока находится в приложении, все вопросы в личку. Приложение: var e:array[1..30] of integer; i,k,min,s:integer; BEGIN for i:=1 to 30 do e[i]:=random(9)-random(9); for i:=1 to 30 do write(e[i]:2); min:=e[1]; for i:=1 to 30 do if e[i]<min then begin min:=e[i]; k:=i; end; writeln; s:=0; for i:=1 to k do if e[i]=0 then inc(s); Writeln('kolichestvo nulei=',s); readln; END. --------- нет ничего невозможного!

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

Вопрос № 155.185

Здраствуйте) Не могли бы вы мне помочь с прошраммами? В методичке дается пример программы, но когда я ее вывожу, она у меня не работает. В интернете подобные программы тоже не находились. 1) Для этой нужно поменять местами min и max соответственно с первым и последним элементами матрицы(вот min и max выводит, а как их поменять местами я не знаю). Program V11; Type Massiv=array [1..10,1..10] of real; Var D:Massiv; i,j,n,m:integer; Max,Min:real; Begin Write('Vvedite kolichestvo strok n='); Readln(n); Writeln('Vvedite kolichestvo stolbchov='); Readln(m); Writeln('Vvedite matrichy D:'); For i:=1 to n do Begin For j:=1 to m do Read(D[i,j]); Readln; End; Writeln('Isxodnaya matricha D:'); For i:=1 to n do Begin For j:=1 to m do Write(D[i,j]:5:2,''); Writeln; End; Max:=D[1,1]; For i:=1 to n do For j:=1 to n do if D[i,j]>max then max:=D[i,j]; Writeln( 9;Maxsimalnyu element Max=',Max:5:2); Min:=D[1,1]; For i:=1 to n do For j:=1 to n do if D[i,j] Writeln('Minimalnyu element Min=',Min:5:2); End. 2) А здесь выводится ошибка типа программа не закончена. Задача: Найти количество положительных элементов массивов S и W. Program V11; Type Massiv=Array[1..100] of real; Var S,W:Massiv; n,m,I:integer; KolPol:integer; Procedure Inp(k:integer;Var H:Massiv); Begin For i:=1 To n Do Read(H); Readln; End; Procedure Out(k:integer;H:Massiv); Begin For i:=1 To m Do Write(H:5:1); Writeln; End; Function K(K:integer;H:Massiv):Real; Var KH:Real; Begin For i:=1 to n Do Read (S); KolPol:=0; for i:=1 to n do if S>0 then begin KolPol:=KolPol+1; For i:=1 to n Do Read (W); KolPol:=0; for i:=1 to n do if W>0 then begin KolPol:=KolPol+1; End; Begin Write('VVedite razmer massiva S,n='); Readln(n); Writel n('Vvedite razmer massiva W,m='); Readln(m); Writeln('VVedite znachenia elementov massiva S:'); Inp(n,S); Writeln('VVedite znachenia elementov massiva W:'); Inp(m,W); Writeln('Isxodniy massiv S:'); Out(n,S); Writeln('Isxodniy massiv W:'); Out(m,W); Writeln('Kolichestvo elementov S=',KolPol:12); Writeln('Kolichestvo elementov W=',KolPol:12); Readln; End.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Чижевская Алина Андреевна! Первую исправил, чтоб не потерять, отправляю, вторую попозже пришлю. Поправил и вторую. Приложение: Program V1; uses crt; Type Massiv=array [1..10,1..10] of real; Var D:Massiv; i,j,n,m,imin,jmin,imax,jmax:integer; Max,Min,x,y:real; Begin clrscr; Write('Vvedite kolichestvo strok n='); Readln(n); Write('Vvedite kolichestvo stolbchov m='); Readln(m); Writeln('Vvedite matrichy D:'); For i:=1 to n do For j:=1 to m do Read(D[i,j]); Readln; clrscr; Writeln('Isxodnaya matricha D:'); For i:=1 to n do Begin For j:=1 to m do Write(D[i,j]:6:2); Writeln; End; Max:=D[1,1];imax:=1;jmax:=1; For i:=1 to n do For j:=1 to m do if D[i,j]>max then begin max:=D[i,j]; imax:=i; jmax:=j; end; Writeln('Maxsimalnyu element Max=',Max:5:2,' v stroke ',imax,' v stolbce ',jmax); Min:=D[1,1];imin:=1;jmin:=1; For i:=1 to n do For j:=1 to m do if D[i,j]<min then begin min:=D[i,j]; imin:=i; jmin:=j; end; Writeln('Minimalnyu element Min=',Min:5:2,' v stroke ',imin,' v stolbce ',jmin); x:=D[1,1];D[1,1]:=D[imin,jmin];D[imin,jmin]:=x; {вот здесь обмен максимального с последним и минимального с первым} y:=D[n,m];D[n,m]:=D[imax,jmax];D[imax,jmax]:=y; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to m do write(D[i,j]:6:2); writeln; end; readln End. Program V2; uses crt; Type Massiv=Array[1..100] of real; Procedure InpOut(k:integer; var H:Massiv); var i:integer; Begin writeln('Vvedite ',k,' elementov massiva:'); For i:=1 To k Do Read(H[i]); Readln; End; Function KolPol(k:integer;H:Massiv):integer; Var i,kp:integer; Begin kp:=0; for i:=1 to k do if H[i]>0 then kp:=kp+1; KolPol:=kp; end; Var S,W:Massiv; n,m,I:integer; Begin clrscr; writeln('Massiv S:'); writeln; Write('Vvedite razmer massiva S, n=');Readln(n); InpOut(n,S); writeln('KolPol S=',KolPol(n,S)); writeln; Writeln('Massiv W:'); writeln; Write('Vvedite razmer massiva W, m=');Readln(m); InpOut(m,W); writeln('KolPol W=',KolPol(m,W)); readln End.

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

Вопрос № 155.195

Здраствуйте уважаемые эксперты!...Помлгите пожалуста с задачкой. Вот условие Дан файл f. Вывисти файл на экран так, чтоб в каждой строчке было не более 40 символов и количество строк минимальной. (файл f любой)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Misha kovalenko! Если я правильно понял условие, то решение в приложении. Если неправильно там же. Приложение: uses crt; var f:text; s:string; i:integer; begin clrscr; assign(f,'stroki.txt');{наш файл с текстом} reset(f);{открываем его для чтения} while not eof(f) do {пока не конец файла} begin readln(f,s);[считываем по строке] for i:=length(s) downto 1 do {с конца строки, чтоб не сбить нумерацию} if i mod 40 =0 then insert(#13+#10,s,i+1); {после каждых 40 символов вставляем символы конца строки и перевода каретки} writeln(s); end; readln; close(f); end.

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

Вопрос № 155.197

Составить процедуру, позволяющую определить позицию самого правого вхождения заданного символа в исходную строку. Если строка не содержит символа, результатом работы процедуры должна быть -1.

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

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Иванов Виктор Олегович! В приложении код функции и процедуры и пример их использования. Поиск осуществляется с помощью цикла for...downto, в котором перебирается вся строка начиная с конца. Удачи!!! Приложение: {функция} function FindChar(str: string; ch: char): integer; var i: integer; begin for i := Length(str) downto 1 do if str[i] = ch then begin FindChar := i; exit; end; FindChar := -1; end; {процедура} procedure FindChar1(str: string; ch: char; var p: integer); var i: integer; begin for i := Length(str) downto 1 do if str[i] = ch then begin p := i; exit; end; p := -1; end; var str: string; ch: char; p: integer; begin Write('str: '); ReadLn(str); Write('char: '); ReadLn(ch); p := FindChar(str, ch); WriteLn('С помощью функции: ', p); FindChar1(str, ch, p); WriteLn('С помощью процедуры: ', p); ReadLn; end.

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

Отвечает: Mixala Здравствуйте, Иванов Виктор Олегович! вот код процедуры - точнее функции, возвращающей позицию. Приложение: function f(s:string;c:char):integer; var i:integer; begin for i:=length(s) downto 1 do //проверяется посимвольно с конца if s[i]=c then begin result:=i; //если найдена, то выход exit; end; result:=-1; //в строке нет символа end;

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Решение данной задачи в приложении (там-же пример использования) Приложение: program find; function FindChar(s:string;ch:char):integer; var i:integer; ss:string; begin ss:=ch; i:=pos(ss,s); if i=0 then i:=-1; FindChar:=i; end; var s:string; c:char; i:integer; begin write ('Vvedie stroky '); readln(s); write ('Vvedite simvol '); readln(c); i:=FindChar(s,c); if i=-1 then writeln('Simvol ne obnaruzen') else writeln('Simvol na ',i,' pozicii'); readln; end.

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

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