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

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

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

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

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

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

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

Выпуск № 769
от 29.12.2008, 15:35

Вопрос № 155507: Здравствуйте уважаемые эксперты, мне очень нужна ваша помощь. Надо срочно написать курсовик по информатике, но я не знаю как =(( Выполнить над квадратной матрицей A порядка n последовательность действий, указанных в задании: 1) вычесть из А...

Вопрос № 155.507

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Vilko! Решение с подробными пояснениями в приложении. Приложение: uses crt; {модуль для работы с экраном и клавиатурой, здесь для очистки экрана} const n=6;{размер матрицы, можно любой} var a,b:array[1..n,1..n] of integer;[тип матрицы} v:array[1..n] of integer;[тип массива} i,j,k:integer;{счетчики циклов} begin clrscr;{очистка экрана} randomize;{генерация случайных чисел} writeln('Matrica A:');{создание и вывод на экран исходной матрицы} for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(5);{берем числа от 0 до 4, чтоб легче проверить в уме суммы, можно ббольше, можно и вещественные} write(a[i,j]:4); end; writeln; end; writeln('Vychitanie edinichnoj matricy:'); for i:=1 to n do begin for j:=1 to n do begin if i=j then a[i,j]:=a[i,j]-1;{из элементов главной диагонали вычитаем 1} write(a[i,j]:4); end; writeln; end; writeln('Transponirovannaya matrica B:'); for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=a[j,i];{просто переворачиваем матрицу относительно главной диагонали} write(b[i,j]:4); end; writeln; end; writeln('Formirovanie vectora V:'); for i:=1 to n do {всего n пар столбцов и строк} begin v[i]:=0;{сначала суммы каждой пары=0} for j:=1 to n do {считаем строку слева направо} v[i]:=v[i]+b[i,j]; for k:=1 to n do {прибавляем столбец, который пересекается с ней на главной диагонали сверху вниз} v[i]:=v[i]+b[k,i]; end; for i:=1 to n doХ{выводим результат} write(v[i],' '); readln end.

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

Вопрос № 155.512

Пожалуйста помогите с решение......в школе туго было с паскалем....Дана действительная матрица размера n*m .Получить последовательность b1,…,bn,где b_k-это произведение квадратов тех элементов k-й строки,модули которых принадлежат отрезку [1;1.5]

Отправлен: 23.12.2008, 18:57 Вопрос задал: Чешков Роман Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Чешков Роман Владимирович! Решение с пояснениями в приложении. Приложение: uses crt; const n=8; {размер матрицы} m=6; var a:array[1..n,1..m] of real;{тип матрицы} b:array[1..n] of real; {тип массива} k,j:integer; {счетчики по строкам и столбцам} begin clrscr;{очищаем экран} randomize;{подключаем генерацию случайных чисел} writeln('Matrica A:'); for k:=1 to n do begin for j:=1 to m do begin a[k,j]:=4*random-2; {заполняем матрицу вещественными числами в инт -2, 2} write(a[k,j]:6:2);{выводим по строкам} end; writeln;{новая строка} end; for k:=1 to n do {идем вниз по строкам} begin b[k]:=1.0;{сначала произведение равно 1} for j:=1 to m do if (abs(a[k,j])>=1)and(abs(a[k,j])<=1.5){если числа подходят по условию, перемножаем их} then b[k]:=b[k]*a[k,j];{и заносим в массив В} end; writeln('Massiv B:');{выводим массив В на экран} for k:=1 to n do write(b[k]:6:2); readln end.

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

Вопрос № 155.517

Дано натуральное число N. Найти все числа Мерсена, меньшие N. Простое число называет ся числом Мерсена, если оно может быть представлено в виде 2p – 1, где р – тоже простое число.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! Программа в приложении решает Вашу задачу. Простые числа Мерсенна выводятся другим цветом. Вопросы задавайте в мини-форум. Удачи! Приложение: uses crt; var n,a:integer; {функция контролирующая простое число} function Prost(x:integer):boolean; begin prost:=false; if x=1 then Prost:=true else if x>=2 then Prost:=((a mod x)>0)and Prost(x-1); end; begin a:=1;{начальная степень} repeat write('Enter N:'); readln(n); until n>0; while round(exp(ln(2)*a)-1)<n do{в цикле перебираем все числа} begin TextColor(7+7*ord(Prost(a-1)));{изменяем цвет для простых чисел Мерсенна} Write((exp(ln(2)*a)-1):8:0);{выводим число Мерсенна} TextColor(7);{востанавливаем цвет по умолчанию} inc(a);{следущая степень} end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 155.518

Дано натуральное число N. Среди чисел 1, …. , N найти все такие числа, запись которых совпадает с последними цифрами записи их квадрата (как, например, 62=36, 252=625 и т.д.).

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! Программа в приложении. При переборе всех чисел выводится даже такое число: 02=02, условию задачи соответствует. Удачи! Приложение: var a,b,n:longint; begin {вводим натуральное число} repeat write('Enter N:'); readln(n); until n>0; {начинаем перебор} while n>1 do begin if (n mod 10)=2 then begin {получаем число и считаем количество цифр} a:=n div 10; b:=0; while a>0 do begin inc(b); a:=a div 10; end; a:=n div 10; {проверяем условие задачи и выводим результат} if a=((a*a) mod round(exp(ln(10)*b)))then writeln(n,' = ',a*a); end; dec(n); end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 155.519

Дано натуральное число N. Выяснить, можно представить N! в виде произведения трех последовательных целых чисел.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Вариант решения Приложение: program test; function factorial(i:longint):longint; begin if i=1 then factorial:=1 else factorial:=factorial(i-1)*i; end; var i,j,k,l:longint; begin write('Vvedite chislo N '); readln(i); j:=factorial(i); writeln('N!=',j); k:=0; for i:=2 to j-1 do begin l:=(i-1)*i*(i+1); if l>j then i:=j-1; if (j=l) then begin k:=i; i:=j-1; end; end; if k=0 then writeln('Net reshenia') else writeln(j,'=',k-1,'*',k,'*',k+1); readln; end.

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

Вопрос № 155.521

Получить все четырехзначные натуральные числа, в записи которых нет двух одинаковых цифр.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! Вариант с ипользованием множеств. Удачи! Приложение: var a,b:integer; c:set of byte; begin a:=9999; repeat c:=[];{сбрасываем множество} b:=a; while (b>0)and not((b mod 10)in c)do begin c:=c+[b mod 10];{формируем множество} b:= b div 10;{убираем уже проверенную цифру} end; if b=0 then write(a:5); dec(a) until a<1000; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Эта программа выводит на экран все четырехзначные натуральные числа, в записи которых нет двух одинаковых цифр. Приложение: program Num; var i,j,k,l:byte; begin for i:=1 to 9 do for j:=0 to 9 do if i<>j then for k:=0 to 9 do if (k<>i)and(k<>j) then for l:=0 to 9 do if (l<>i)and(l<>j)and(l<>k) then writeln(i*1000+j*100+k*10+l); readln; end.

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

Вопрос № 155.523

Даны натуральные числа N и М (М≥N). Определить, сколько из чисел N, N+1, … , M являются номерами високосных годов.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! В приложении код программы со всеми пояснениями. С уважением, Дмитрий. Приложение: program z155523; Function visokos(god:Integer):boolean; begin {год считается високосным, если он делится на 4. Но из всех, делящихся на 100 - только те, которые делятся на 400} visokos:=((god mod 100 <> 0)and(god mod 4 = 0))or(god mod 400 = 0); end; var i,kol,N,M:Integer; begin Write('Enter N: ');{ввод данных} ReadLn(n); Write('Enter M (M>=N): '); ReadLn(m); kol:=0; For i := N to M do{перебираем все года в промежутке от N до M} IF visokos(i) then inc(kol);{считаем кол-во високосных}{} WriteLn('Кол-во високосных годов в промежутке от ',n,' до ',m,' = ',kol); ReadLn(); end.

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

Вопрос № 155.524

Даны натуральные числа a, b,c, которые обозначают число, месяц и год. Определить, сколько полных дней осталось до конца года.

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

Отвечает: Boriss Здравствуйте, Иванов Виктор Олегович! Ну, это просто. В приложении код, который сильно не тестировал, но, по-моему, должно работать правильно (если ввести правильные значения) Приложение: const Days: array [1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 30, 30, 31, 30, 31); var Day, month, year, count, i: Integer; function IsLeapYear(Y: Integer): Boolean; {високосный или нет} begin IsLeapYear := ((Y mod 4) = 0) and ((Y mod 100) <> 0); end; begin WriteLn('Введите день: '); ReadLn(day); WriteLn('Введите номер месяца: '); ReadLn(month); WriteLn('Введите год: '); ReadLn(Year); If IsLeapYear(year) then inc(days[2]); count := 0; for i:=12 downto (month+1) do count := count + days[i]; count := count + days[month] - day - 1; WriteLn(count); end. --------- Вывод - то место в тексте, где вы устали думать

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

Вопрос № 155.532

Добрый вечер...Помогите пожалуйста мне....Вычислить бесконечную сумму с заданной точностью ε(ε>0).Считать что требуемая точность достигнута,если несколько первых слагаемых и очередное слагаемое оказалось по модулю меньше,чем ε,это и все последующие слагаемые можно не учитывать.Вычислить бесконечную сумму [(-2)]в i-степени / на iфакториал??????

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

Отвечает: Шичко Игорь Здравствуйте, Чешков Роман Владимирович! Предлагаю следующий вариант решения. Код в приложении. Используются функции для вычисления степени и факториала. Приложение: function Fact(n:integer): integer; var i, temp: integer; begin temp:= 1; for i:= 1 to n do temp:= temp * i; Fact:= temp; end; function Stepen(n:integer; p: integer): integer; var i, temp: integer; begin temp:= 1; for i:= 1 to p do temp:= temp * n; Stepen:= temp; end; var summ, av, temp: real; i: integer; begin summ:= 0; writeln('Vvedite tochnost (>0) '); readln(av); if av = 0 then begin writeln('Vvedite tochnost >0 '); exit; end; i:= 1; temp:= av + 2; while temp > av do begin temp:= Abs(Stepen(-2,i) / Fact(i)); if temp > av then summ:= summ + Stepen(-2,i) / Fact(i); i:= i+1; end; writeln('Summ = ', summ:10:2); readln; end.

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

Вопрос № 155.537

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

Отправлен: 23.12.2008, 21:50 Вопрос задала: Natasha N (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Шевченко Дмитрий Здравствуйте, Natasha N! В приложении код программы со всеми пояснениями. С уважением, Дмитрий. Приложение: program z151816; Function est_2a(sl:string):boolean; var kol:Integer; symb:char; begin kol:=0; symb:='а';{если а - русская} symb:='a';{если a - латинская} While pos(symb,sl)>0 do{ищем символ в слове} begin delete(sl,pos(symb,sl),1); kol:=kol+1;{считаем количество} end; est_2a:=kol>2;{если кол-во > 2 - то слово надо удалить из строки} end; Function est_slova(var s:string):boolean; var sl,s2:string; res:boolean; begin res:=false; s2:=''; While length(s) > 0 do{перебираем строку} begin sl:=''; While s[1] = ' ' do{удалем пробелы из начала/между словами} begin s2:=s2+' '; delete(s,1,1); end; While (s[1]<>' ')and(length(s) > 0) do{пока не дошли до пробела или конца строки} begin sl:=sl+s[1];{набираем слово} delete(s,1,1); end; IF not est_2a(sl) then{если в слове не больше 2х букв а, то} s2:=s2+sl{приписываем его к строке} Else res:=true;{если больше двух букв - то у нас есть как минимум одно такое слово} end; s:=s2; est_slova:=res; end; var s:String; begin WriteLn('Введите текст: '); ReadLn(s); IF est_slova(s) then{если есть хотя бы одно слово в котором больше 2х букв а} WriteLn('Result: ',s){выводим строку} Else{иначе} WriteLn('Во введённой Вами строке нет слов, в которых больше двух букв "a"');{выводим соответствующее сообщение} ReadLn(); end.

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

Отвечает: Andersen Здравствуйте, Natasha N! Вот решение вашей задачи только проверьте "а" русская или английская Приложение: program word; var i,j,k:byte; s1,s2,ss:string; b:boolean; begin b:=true; write('Введите текст :'); readln(s1); s2:=''; ss:=''; s1:=s1+' '; for i:=1 to length(s1) do if s1[i]=' ' then begin k:=0; for j:=1 to length(ss) do if ss[j]='a' then k:=k+1; if k<=2 then begin if ss<>'' then if s2='' then s2:=ss else s2:=s2+' '+ss; ss:=''; end else begin b:=false; ss:=''; end; end else ss:=ss+s1[i]; writeln(s2); if b then writeln('слов с большим колличеством букв "a" нет'); readln; end.

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

Отвечает: Костя Симанович Здравствуйте, Natasha N! Отвечу на вопрос из минифорума. Один из вариантов решения в приложении с пояснениями, постарался расписать как можно подробнее. Хочу заметит, что если введен один символ, он считается как удовлетворяющий условию. (Начинается и заканчивается на одну и ту же букву.) Слова считаются в предложении только до первой точки. Удачи. Приложение: program zad1; const zp = ['.']; {множество знаков препинания, у нас точка} var str : string; {строка} i, l, k, nw : integer; a : integer; {позиция первой точки} begin k := 0; a := 0; i := 1; {задаём начальные значения счётчиков} writeln('Введите строку'); readln(str); {вводим строку} l := length(str); {определяем длину строки} while not (str[i] in zp) do {ищем позицию первой точки} inc(i); a := i; i := 1; str := copy(str, 1, a-1); {копируем в строку всё до точки} l := length(str); {заново пересчитываем длину строки} while (i <= l) do {пока не конец строки} begin if str[i] = ' ' then inc(i); {пропускаем пробел i увел. на 1} nw := i; {запоминаем номер начала слова} while (i <= l) and (str[i] <> ' ') do begin inc(i); {в цикле прокручивается слово до следующего пробела} end; if str[nw] = str[i-1] then inc(k); {если первый и последний символ одинакове увел на 1} end; writeln('Кол - во слов удовлетворяющих задаче = ', k); readln; {ждем нажатия клавиши ентер} end.

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

Вопрос № 155.555

Добрый день, уважаемые эксперты, очень нужна ваша помощь! 1) Дана действительная матрица размера 6*9. Найти среднее арифметическое наибольшего и наименьшего значений ее элементов. 2)Составить программу для вычисления Z=((a-x1)*(a-x2))/((b-y1)*(b-y2)) , где x1 и х2 корни уравнения. ах^2-х+1=0; у1 и у2 - корни уравнения 2у^2+у-b =0. Если корни мнимые, то считать их равными нулю. Для вычисления корней использовать процедуру. Заранее благодарю за помощь.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Annie! Решение задач в приложении. По второй задаче: Введено условие, что а<>0, т.к уравнение ах^2-х+1=0 не будет квадратным и не будет иметь 2 корня и b<>0 , т.к при этом у1=0, и b-y1=0, а на 0 делить нельзя. Приложение: 1) Дана действительная матрица размера 6*9. Найти среднее арифметическое наибольшего и наименьшего значений ее элементов. uses crt; const n=6; {размеры матрицы} m=9; var a:array[1..n,1..m] of real;{тип матрицы} k,j:integer; max,min:real; begin clrscr; randomize; writeln('Matrica A:'); {создание и вывод на экран} for k:=1 to n do begin for j:=1 to m do begin a[k,j]:=10*random-2; write(a[k,j]:6:2); end; writeln; end; max:=a[1,1];min:=a[1,1];{поиск мин и макс} for k:=1 to n do for j:=1 to m do if a[k,j]>max then max:=a[k,j] else if a[k,j]<min then min:=a[k,j]; writeln('Max=',max:0:2,' Min=',min:0:2,' Srednee=',(max+min)/2:0:2);{вывод на экран} readln end. 2)Составить программу для вычисления Z=((a-x1)*(a-x2))/((b-y1)*(b-y2)) , где x1 и х2 корни уравнения. ах^2-х+1=0; у1 и у2 - корни уравнения 2у^2+у-b =0. Если корни мнимые, то считать их равными нулю. Для вычисления корней использовать процедуру. uses crt; procedure SqrtKr(p,q,r:real; var k1,k2:real);{процедура нахождения корней уравнений} var D:real; begin D:=q*q-4*p*r;{дискриминант} if D<0 then {если меньше ноля} begin k1:=0; {корны равны нулю по условию} k2:=0; end else if D=0 then {=0} begin k1:=-q/(2*p); {2 одинаковых корня} k2:=-q/(2*p); end else if D>0 then {больше ноля} begin k1:=(-q+sqrt(D))/(2*p);{два разных корня} k2:=(-q-sqrt(D))/(2*p); end; end; var Z,a,b,x1,x2,y1,y2:real; begin clrscr; repeat write('a=');readln(a); write('b=');readln(b); until (a<>0)and(b<>0);{пояснение выше} SqrtKr(a,-1,1,x1,x2); {вызываем процедуру для 1 уравнения} SqrtKr(2,1,-b,y1,y2);{вызываем процедуру для 2 уравнения} Z:=((a-x1)*(a-x2))/((b-y1)*(b-y2)); {вычисляем} write('Z=',Z:0:2); readln end.

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

Вопрос № 155.564

помогите пожалуйста! никак не пойму как написать код к задаче: Задана последовательность из N вещественных чисел. Вычислить порядковый номер числа наиболее приближенному к среднему арифметическому максимального и минимального чисел данной последовательности. Заранее спасибо за оказонное внимание и помощь!

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

Отвечает: Шичко Игорь Здравствуйте, Clava3004! Предлагаю Вам вариант решения. Код в приложении. Приложение: const n = 30; var mas: array[1..n] of real; i, ind: integer; max, min, av, min_av: real; begin randomize; writeln('Massiv _ 1'); for i:= 1 to n do begin mas[i]:= (Random(50) - 20) / 3; write(mas[i]:6:2); if i mod 10 = 0 then writeln; end; max:= mas[1]; min:= mas[1]; for i:=2 to n do begin if mas[i] > max then max:= mas[i]; if mas[i] < min then min:= mas[i]; end; writeln('Max =', max:6:2); writeln('Min =', min:6:2); writeln; av:= (max - min) / 2; min_av:= Abs(mas[1] - av); ind:= 1; for i:= 2 to n do if Abs(mas[i] - av) < min_av then begin min_av:= Abs(mas[i] - av); ind:= i; end; writeln('Av =', av:5:2); writeln('Min_Av =', min_av:5:2); writeln('Element: #', ind:2, ' znachenie = ', mas[ind]:6:2); readln; end.

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

Вопрос № 155.565

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Neoden! Решение задачи с пояснениями в приложении. Приложение: uses crt; const n=4; {размер матрицы} function SumCif(z:integer):boolean;{функция считает сумму цифр и определяет ее четность} var s,t:byte; begin s:=0; {сумма=0} while z>0 do {пока число не 0} begin t:=z mod 10; {отделяем по одной цифре с конца} s:=s+t; {складываем} z:=z div 10;{берем число без последней цифры и все повторяем} end; if odd(s) then SumCif:=false{если сумма нечетная, нет} else SumCif:=true;{если четная, да} end; var a:array[1..n,1..n] of integer; k,j,p,s:integer; begin clrscr; writeln('Vvedite ',n*n,' elementov matricy:');{вводим матрицу с консоли, чтобы легче тестировать} for k:=1 to n do for j:=1 to n do read(a[k,j]); readln; clrscr; writeln('Matrica A:');{выводим ее на экран} for k:=1 to n do begin for j:=1 to n do write(a[k,j]:4); writeln; end; writeln; writeln('Podschet proizvedenij:'); writeln; for j:=1 to n do {проверяем все столбцы} begin p:=1;{принимаем произведение=1} for k:=1 to n do {идем по столбцу вниз} if SumCif(a[k,j]) then p:=p*a[k,j]; {если сумма цифр четная, перемножаем} if p=1 then writeln('Takih chisel v stolbce ',j,' net!'){если не изменилась, нет} else writeln('Proizvedenie v stolbce ',j,' =',p);{если изменилась, выводим} end; writeln; writeln('Proverka ubyvania:'); s:=0; for k:=1 to n do {проверяем строки} begin p:=0; for j:=2 to n do if a[k,j]<=a[k,j-1] then p:=p+1;{если убывают, считаем} if p=n-1 then s:=s+1;{если все в строке убывают, добавляем строку} end; if s=n then writeln('Vse stroki uporjadocheny po ubyvanju!'){если все строки, то да!} else writeln('Ne vse stroki uporjadocheny po ubyvanju!');{если нет, то нет!} readln end.

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

Вопрос № 155.604

Здравствуйте эксперты! Помогите ответить на вопрос: От чего зависит количество итераций в итерационных методах, кроме задаваемой точности?

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Юмов Игорь Олегович! Отвечая на вопрос №96704, была написана программа для расчета корней уравнения тремя методами и вывода их на экран. В каждом методе по разному считается следующее значение, при постоянной точности. Думаю Вам будет полезно посмотреть как происходит поиск, при этом Вы можете поменять саму функцию, точность, начальное и конечное значение. Т.е. зависит ещё и от самого метода, вернее от того как считается следующее значение. Удачи! Приложение: program q96704; uses Graph,Crt; const x0=0.97;{начало} x1=1.5;{конец} e=0.0001;{точность} h=0.00001;{} var x,xA,xB:real; grDriver,grMode:integer; {сама функция} function myFN(x:real):real; begin myFN:=ln(x*(x+9))/ln(10)-ln((x+9)/x)/ln(10); end; {считаем координату Y для графика} function myPointY(x:real):integer; begin myPointY:=200+round(int(20*(myFN(x1)/myFN(x0))*GetMaxY*myFN(x))/GetMaxY); end; {считаем координату X для графика} function myPointX(x:real):integer; begin myPointX:=round(int(GetMaxX*((x-x0)/(x1-x0)))); end; {вывод графика} procedure myFunctionOut; var i:integer; begin {ось Х} Line(0,200,GetMaxX,200); for i:=0 to GetMaxX do begin PutPixel(i,myPointY(x0+(x1-x0)*i/GetMaxX),13); end; end; begin {включаем графику} grDriver:=0; InitGraph(grDriver,grMode,''); {метод дихотомии} ClrScr; myFunctionOut; xA:=x0; xB:=x1; repeat Circle(myPointX(xA),myPointY(xA),1); Circle(myPointX(xB),myPointY(xB),1); x:=(xA+xB)/2; if(myFN(xA)*myFN(x)<0)then begin xB:=x; end else begin xA:=x; end; ReadKey; until (abs(xA-xB)<e)or(myFN(xA)*myFN(xB)>0); Circle(myPointX(x),myPointY(x),1); ReadKey; {метод секущих хорд} ClrScr; myFunctionOut; xA:=x0; xb:=x1; repeat Circle(myPointX(xA),myPointY(xA),1); Circle(myPointX(xB),myPointY(xB),1); x:=xB-myFN(xB)*(xB-xA)/(myFN(xB)-myFN(xA)); xA:=xB; xB:=x; ReadKey; until (abs(xB-xA)<e)or(myFN(xB)*myFN(xA)<0); Circle(myPointX(xB),myPointY(xB),1); ReadKey; {метод ньютона (касательных или с аппроксимацией производной (метод хорд))} ClrScr; myFunctionOut; x:=x0; xA:=0; repeat Circle(myPointX(x),myPointY(x),1); x:=x-xA; xA:=h*myFN(x)/(myFN(x+h)-myFN(x)); ReadKey; until abs(xA)<e; Circle(myPointX(x),myPointY(x),1); ReadKey; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 155.608

Даны действительные числа a, b, c. Получить: Вычисление max оформить в виде функции.

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

Отвечает: Шичко Игорь Здравствуйте, Иванов Виктор Олегович! Примерный код в приложении. Думаю, пояснений не нужно. Приложение: function Max(x:real; y:real): real; begin if x > y then Max:= x else Max:= y; end; var a, b, c, rez: real; begin writeln('Vvedite a'); readln(a); writeln('Vvedite b'); readln(b); writeln('Vvedite c'); readln(c); if 1 + Max(a + b * c, 1.15) <> 0 then begin rez:= (Max(a, a+b) + Max(a, b+c)) / (1 + Max(a + b * c, 1.15)); writeln('Rezult = ', rez:7:2); end else writeln('Rezult = NO, znamenatel = ', 1 + Max(a + b * c, 1.15) ); {если знаменатель равен нулю} readln; end.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Решение задачи Приложение: program func; function Max2(x,y:real):real; begin if x>y then Max2:=x else Max2:=y; end; var a,b,c,r:real; begin write('Vvedite chislo A :'); readln(a); write('Vvedite chislo B :'); readln(b); write('Vvedite chislo C :'); readln(c); r:=(Max2(a,a+b)+Max2(a,b+c))/(1+Max2(a+(b*c),1.15)); writeln('Rezult :',r:14:6); readln; end.

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

Вопрос № 155.611

Даны координаты вершин двух треугольников. Определить, какой из них имеет большую площадь.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! В приложении код со всеми пояснениями. С уважением, Дмитрий. Приложение: program treugolnik; procedure vvod(var x,y:Extended; nomer:string); begin Write('введите x и y '+nomer+' точки(через пробел): '); Readln(x,y); end; Procedure vvod_tochek(var x1,x2,x3,y1,y2,y3:Extended); begin vvod(x1,y1,'первой'); vvod(x2,y2,'второй'); vvod(x3,y3,'третьей'); end; Function rasst(x1,x2,y1,y2:Extended):Extended; begin rasst:=sqrt(sqr(x2-x1)+sqr(y2-y1));{расстояние между двумя точками} end; Function Est_treug(x1,x2,x3,y1,y2,y3:Extended):boolean; begin {проверяем чтобы каждая сторона была по длине меньше суммы 2х других} Est_treug:=(rasst(x1,x2,y1,y2) < (rasst(x1,x3,y1,y3)+rasst(x2,x3,y2,y3)))and (rasst(x1,x3,y1,y3) < (rasst(x2,x3,y2,y3)+rasst(x1,x2,y1,y2)))and (rasst(x2,x3,y2,y3) < (rasst(x1,x3,y1,y3)+rasst(x1,x2,y1,y2))); end; procedure Storoni(var a,b,c:Extended;x1,x2,x3,y1,y2,y3:Extended); begin a:=rasst(x1,x2,y1,y2);{найти стороны} b:=rasst(x2,x3,y2,y3); c:=rasst(x1,x3,y1,y3); end; Function ras_s(x1,x2,x3,y1,y2,y3:Extended):Extended; var a,b,c,poluper:Extended; begin IF Est_treug(x1,x2,x3,y1,y2,y3) then{если точки образуют треугольник, то} begin Storoni(a,b,c,x1,x2,x3,y1,y2,y3);{расчитываем стороны} poluper:=(a+b+c)/2; ras_s:=sqrt(poluper*(poluper-a)*(poluper-b)*(poluper-c));{считаем площадь по формуле Герона} end else begin WriteLn('треугольника с заданными координатами вершин не существует'); ReadLn(); Halt(0); end; end; var x1,x2,x3,y1,y2,y3:Extended; s1,s2:Extended; begin WriteLn('Первый треугольник: '); vvod_tochek(x1,x2,x3,y1,y2,y3);{ввести координаты точек} s1:=ras_s(x1,x2,x3,y1,y2,y3);{рассчитать площадь первого треугольника} WriteLn('Второй треугольник: '); vvod_tochek(x1,x2,x3,y1,y2,y3);{ввести координаты точек} s2:=ras_s(x1,x2,x3,y1,y2,y3);{рассчитать площадь второго треугольника} IF s2>s1 then WriteLn('Площадь второго треугольника больше') Else WriteLn('Площадь первого треугольника больше'); ReadLn(); end.

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

Вопрос № 155.614

Два простых числа называются "близнецами", если они отличаются друг от друга на 2 (таковы, например, числа 41 и 43). Напечатать все пары "близнецов" из отрезка [n, 2n], где n -- заданное целое число, большее 2.

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

Отвечает: Костя Симанович Здравствуйте, Иванов Виктор Олегович! Если правильно понял задачу, то один из вариантов решения в приложении. Удачи. Приложение: program chis; var n : real; i : real; begin writeln('введите n.'); readln(n); if n >= 2 then begin i := n; writeln('Пары чисел из диапазона ', n:5:0, ' до ', (2*n):5:0); repeat writeln(i:5:0, ' ', (i + 2):5:0); i := i + 1; until i+2 > 2*n; end else writeln('Заданное число не удовлетворяет заданию.'); readln; end.

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

Вопрос № 155.616

По заданным 20-элементным целым массивам x и y вычислить

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! В приложении код программы. С уважением, Дмитрий. Приложение: program z155616; const N = 20;{количество элементов в массиве} type elem = Integer;{тип элементов в массиве} mas = array[1..N] of elem; procedure vivod(m:mas); var i:byte; begin For i:= 1 to N-1 do Write(m[i],' '); WriteLn(m[N]); end; Function summa(m:mas;a,b:byte):elem; var i:byte; sum:elem; begin sum:=0; For i:= a to b do{считаем сумму квадратов элементов от a до b} sum:=sum+sqr(m[i]); summa:=sum; end; var x,y:mas; i:byte; sum:Integer; begin {Если надо вводить массиы вручную:} For i := 1 to N do begin Write('Enter x[',i,']: '); ReadLn(x[i]); end; vivod(x); For i := 1 to N do begin Write('Enter y[',i,']: '); ReadLn(y[i]); end; vivod(y); {Если произвольно заполнить:} Randomize; For i := 1 to N do x[i]:=Random(21)-10;{заполняем случайными числами от -10 до 10} vivod(x); For i := 1 to N do y[i]:=Random(21)-10;{заполняем случайными числами} vivod(y); {основная часть:} sum:=0; For i:= 1 to 15 do{рассчитываем значение условия} sum:=sum+sqr(x[i])*sqr(y[i]); IF sum>0 then WriteLn('u = ',summa(x,1,N)) else WriteLn('u = ',summa(y,10,N)); end.

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

Вопрос № 155.618

Описать функцию next без параметров, которая считывает из введённой строки первую литеру, отличную от пробела, и объявляет ее своим значением. Использовать эту функцию для подсчета k -- количества отличных от пробела литер текста, который задан во входной строке и за которой следует точка.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! В приложении код программы со всеми пояснениями. Если точку тоже надо считать - следует написать WriteLn('Result: ',kol+1);{выводим ответ} А если не надо, чтобы введённая строка отображалась на экране - Function next:char; var c:char; begin c:=ReadKey;{считываем введённый символ} While c=' ' do{ищем первый, отличный от пробела} c:=ReadKey; next:=c;{возвращаем его} end; С уважением, Дмитрий. Приложение: program z155618; uses crt; Function next:char; var c:char; begin c:=ReadKey;{считываем введённый символ} Write(c);{выводим его не экран(чтобы отображалось что мы нажали)} While c=' ' do{ищем первый, отличный от пробела} begin c:=ReadKey; Write(c); end; next:=c;{возвращаем его} end; var c:char; kol:Integer; begin kol:=0; WriteLn('Введите строку:'); c:=next; While c<>'.' do{пока не ввели точку - } begin inc(kol);{считаем количество символов, отличных от пробела} c:=next; end; WriteLn(); WriteLn('Result: ',kol);{выводим ответ} ReadLn(); end.

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

Вопрос № 155.620

type vect = array [1..20] of char; Описать процедуру modify(x, y, a, b) от четырех векторов, которая преобразует векторы х и у к следующему виду: x = (a1, a2, ... , a8, x9, x10, ... , x20), y = (y1, ... , y5, b1, ... , b6, y12, ..., y16, a1, ... , a4).

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! В приложении код процедуры С уважением, Дмитрий. Приложение: procedure modify(var x,y:vect;a,b:vect); var i:byte; begin For i:=1 to 8 do x[i]:=a[i];{x[1..8] заменяем на a[1..8]} For i:=6 to 11 do y[i]:=b[i-5];{y[6..11] заменяем на b[1..6]} For i:=17 to 20 do y[i]:=a[i-16];{y[17..20] заменяем на a[1..4]} end;

Ответ отправил: Шевченко Дмитрий (статус: 9-й класс) Ответ отправлен: 24.12.2008, 15:22 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 239523 на номер 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