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

Выпуск № 644
от 28.04.2008, 10:35

Вопрос № 133.517

Уважаемые эксперты,Помогите пожалуйста решить задачу в Pascal!!!_Очень надо!!! Задача:_Дан массив целых чисел,содержащий 15 элементов. Записать в этом же массиве сначала все кратные трём числа, а затем все остальные, сохраняя порядок их следования.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, LedyAG! Программа в приложении. Удачи! Приложение: uses crt; const n=15; type Ta=array[1..n]of integer; var a:Ta; b,c:integer; procedure change(var a:Ta;b,c:integer); var d:integer; begin while ((a[c-1]mod 3)>0)and(c>b)do begin {перестановка элементов массива} d:=a[c]; a[c]:=a[c-1]; a[c-1]:=d; dec(c); end; for b:=1 to n do begin {только для подсветки чисел кратных 3-ем} if(a[b]mod 3)=0 then textcolor(15); {вывод} write(a[b]:4); textcolor(7); end; writeln; end; begin {массив формируется случайно} randomize; for b:=1 to n do begin a[b]:=random(98)+1; {подсвечиваем кратные элементы} if(a[b]mod 3)=0 then textcolor(15); {выводим} write(a[b]:4); textcolor(7); end; writeln; {сортировка массива} for b:=1 to n-1 do for c:=b+1 to n do if ((a[b]mod 3)>0)and((a[c]mod 3)=0)then change(a,b,c); ReadKey; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.545

Нужно написать програму которая будет щитать большие числа по формуле x:=N*M/2-(N+M) DIV 2, n,m имеють до 15 знаков

Отправлен: 22.04.2008, 11:22 Вопрос задал: ПАВЛО (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: SHERRY !!! Здравствуйте, ПАВЛО! Попробуйте мой код (см. приложение) Числа типа Real хранят только 11-12 чисел. Здесь надо использовать тип comp ----- ∙ Отредактировал: Boriss (Профессор) ∙ Дата редактирования: 22.04.2008, 13:07 Приложение: var N, M,x: real; begin Readln(N, M); { vvodim N i M } x:=N*M/2-(N+M); x:= x / 2; writeln(Round(Int(x))); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 7-ой класс) Ответ отправлен: 22.04.2008, 11:37

Отвечает: Евчик Сергей Александрович Здравствуйте, ПАВЛО! Может стоит подключить математический сопроцессор и использовать переменные типа Extended 3.6 E-4951...1.1 E+4932 Приложение: {$N+} uses crt; var a,m,n:extended; begin clrscr; Writeln('Введите М и N'); readln(m,n); a:=N*M/2-(N+M) DIV 2 Writeln(a); readln; end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 22.04.2008, 14:30

Вопрос № 133.557

НАПИСАЛ ПРОГРАМУ КОТОРАЯ ВОЗВОДИТ ЧИСЛО "2" В ЛЮЬУЮ СТЕПЕНЬ, КОТОРАЯ МЕНШЕ 20000, НО ОНА РАБОТАЕТ ОКОЛО 5сек., А МНЕ НУЖНО, ЩТОБИ ОНО ЩИТАЛА ЗА 0.5сек. ПРОГРАМА В ПРИЛОЖЕНИЕ. НЕДЕЮСЬ НА ПОМОЧЬ. Приложение: PROGRAM STEP; var i,j,k,prn,x,STP:integer; a:array [1..7000] of BYTE; begin READLN(STP); a[7000]:=2; prn:=0; IF STP=0 THEN A[7000]:=1; for i:=2 to stp do for j:=7000 downto 1 do begin x:=a[j]*2; a[j]:=(x+prn) mod 10; prn:=(x+prn) div 10; end; k:=1; while (a[k]=0) do k:=k+1; for i:=k to 7000 do write(a[i]:1); WRITELN; end.

Отправлен: 22.04.2008, 11:44 Вопрос задал: ПАВЛО (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Евчик Сергей Александрович !!! Здравствуйте, ПАВЛО!Число в степень можно возвести по формуле:x^y(x в степени y)=exp(ln(x)*y) Я думаю не стоит изобретать велосипед когда можно воспользоваться готовой формулой! Удачи. Велосипед конечно штука полезная, но... В данном случае НЕ применима, поскольку 220000 весьма "хвостатое" (большое) число, и соответственно НЕ влезет ни в один из стандартных целочисленных типов. Данная задача решается с использованием длинной арифметики! ----- ∙ Отредактировал: Gh0stik (Академик) ∙ Дата редактирования: 24.04.2008, 00:01

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 22.04.2008, 14:14

Отвечает: Denisss Здравствуйте, ПАВЛО! В приложении пример реализации, полученный путем оптимизации Вашего кода. Для максимальной оптимизации пришлось использовать ассемблерные вставки. У меня полученный код работает намного быстрее (при вводе числа 20000), чем предложенный Вами, результат получается одинаковый. При оптимизации пользовался следующими правилами: 1. Умножение на 2 соответствует сдвигу числа влево (shl) на 1 разряд. 2. При умножении на 2, максимально возможный перенос равен 1. В связи с этим mod 10 заменено на сравнение числа с 9-кой и вычитанием 10-ти. Если число больше 9-ти, то перенос равен единице. 3. Нет смысла каждый раз перебирать все N (7000) элементов массива - это сильно увеличивает время подсчета. Лучше сделать цикл for j:= N downto k do ... а после этого цикла, если присутствует перенос, то уменьшить k на 1. При таком подходе нет необходимости в определении числа k перед выводом результата, т.к. она будет определена в ходе вычислений. PS Не удивлюсь, если данный код можно еще дополнительно оптимизировать. Как говорится, "нет предела совершенству". Успехов! Приложение: program Q133557; const N = 7000; var i, k, STP:integer; a:array [1..N] of BYTE; begin READLN(STP); a[N]:= 2; IF (STP = 0) THEN A[N]:= 1; k:= N; asm {if stp <= 1 then goto @@ready;} cmp stp, 1; jle @@ready; {for i:= 2 to stp} mov bp, 2; @@mainloop: mov bx, offset a; add bx, N; {bx:= @a[N];} mov cx, N; {cx:= N;} xor dx, dx; {dx:= 0; - prn} {for j:= N downto 1} @@loop: dec bx; {bx:= @a[j];} mov al, [bx]; {al:= a[j];} shl al, 1; {al:= al*2;} mov [bx], al; {a[j]:= al;} add al, dl; {al:= al + prn;} xor dx, dx; {prn:= 0;} cmp al, 9; {if al <= 9 then goto @@noprn;} jle @@noprn; sub al, 10; {al:= al - 10;} inc dx; {prn:= 1;} @@noprn: mov [bx], al; {a[j]:= al;} dec cx; cmp cx, k; jge @@loop; {end; //for } cmp dl, 1; {if prn < 1 then goto @@endfor;} jl @@endfor; dec k; {k:= k - 1;} dec bx; {bx:= @a[k];} mov [bx], dl; {a[k]:= prn;} @@endfor: inc bp; cmp bp, stp; jle @@mainloop; {end; //for } @@ready: end; for i:= k to N do write(a[i]:1); WriteLn; ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 22.04.2008, 23:51

Вопрос № 133.571

определить делителем каких чисел из (a,b,c) является целое число d.

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

Отвечает: -=Dr. Штопор=- Здравствуйте, Азаркина Полина Александровна! Используем оператор остатка от целочисленного деления mod. Логично, если остаток равен нулю, число делится :) В общем, код смотрите в приложении ____________________________ Tantum possumus, quantum scimus Приложение: program p133571; var a,b,c,d:integer; BEGIN writeln('Введите a,b,c'); readln(a,b,c); writeln('Введите d'); readln(d); if (a mod d <> 0) and (b mod d <> 0) and (c mod d <> 0) then writeln('На ',d,' не делится ни одно число :( ') else begin write('На d делятся: '); if a mod d = 0 then write('a '); if b mod d = 0 then write('b '); if c mod d = 0 then write('c '); end; end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 22.04.2008, 13:53

Вопрос № 133.574

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

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

Отвечает: -=Dr. Штопор=- Здравствуйте, Азаркина Полина Александровна! Код в приложении. Используется функция frac(x), которая позволяет найти дробную часть вещественного числа. ____________________________ Tantum possumus, quantum scimus Приложение: program p133574; var a,b,c:real; BEGIN writeln('Введите a,b,c'); readln(a,b,c); if (frac(a)<>0) and (frac(b)<>0) and (frac(c)<>0) then writeln('Целых чисел нет') else begin write('Целые числа: '); if frac(a)=0 then write('a '); if frac(b)=0 then write('b '); if frac(c)=0 then write('c '); end; end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 22.04.2008, 13:06

Отвечает: Евчик Сергей Александрович Здравствуйте, Азаркина Полина Александровна! Код в приложении. Приложение: Program z1; uses crt; var a,b,c:real; begin Writeln('Введите три числа: '); readln(a,b,c); if round(a)=a then Writeln('a целое'); if round(b)=b then Writeln('b целое'); if round(c)=c then Writeln('c целое'); readln end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 22.04.2008, 14:01

Вопрос № 133.588

Уважаемые эксперты!! помогите пожалуйста решить задачу в Pascal: Разработайте программу расчета функции y = 4ax2 + 3,7b +c, где с =2,7 a  [1;2], ha = 0,5; b  [1;2], hb = 0,5; x  [0;1], hx = 0,2. Используйте одновременно все три цикла for, repeat и while.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, LedyAG! Решение задачи в приложении. Поскольку всего 54 решения, то чтобы их все рассмотреть создан тройной счетчик итераций, который позволяет выводить на экран результат порциями по 18 строчек. Все остальное просто три цикла и формула. Приложение: uses crt; var a,b,c,x,ha,hb,hx,y:real; i,j,k,n:integer; begin clrscr; c:=2.7;ha:=0.5;hb:=0.5;hx:=0.2; a:=1.0;n:=0; {n – счетчик по а=[1,3]} while a<=2.0 do begin b:=1.0;k:=0; {k – счетчик по b=[1,3]} repeat x:=0;j:=0; for i:=1 to 6 do begin y:=4*a*x*x+3.7*b+c; writeln('a=',a:4:1,' b=',b:4:1,' x=',x:4:1,' y=',y:5:1); j:=j+1; {j – счетчик по x=[1,6]} x:=x+hx; end; b:=b+hb; k:=k+j; {6,12,18} until b>2.0; a:=a+ha; n:=n+k; {18,36,54} if n mod 18=0 then readln;{задержка для просмотра порции результатов} end; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 08:13

Вопрос № 133.596

ПОЖАЛУЙСТА!!!! СОСТАВЬТЕ ПРОГРАММУ, ДЛЯ НАХОЖДЕНИЯ, ВСЕХ ПРЯМОУГОЛЬНИКОВ ЗАДАННОЙ ПЛОЩАДИ . СЧИТАЙТЕ, ЧТО ДЛИНЫ СТОРОН ПРЯМОУГОЛЬНИКОВ И ПЛОЩАДЬ ВЫРАЖАЮТСЯ НАТУРАЛЬНЫМИ ЧИСЛАМИ.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. В двойном цикле перемножаем числа меньшие корня из S на числа от корня из S до S и выводим их парами на экран. Приложение: uses crt; var S,a,b,q,i,j:word; begin clrscr; write('S=');readln(s); q:=round(sqrt(S)); writeln('Dliny storon:'); for i:=1 to q do for j:=q to S do if i*j=S then begin writeln('a=',i,' b=',j); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 09:14

Вопрос № 133.607

О ВЛАДЫКИ МИРА!!!УВАЖАЕМЫЕ ЭКСПЕРТЫ!!! помогите! составить програмку которая решает задачу: В первый день было изготовлено 3 коробки игрушек (в коробке 36 игрушек). На каждый день выпуск игрушек увеличивается на 15% от предыдущего дня. Каким будет суммарным выпуск коробок с иг- рушками на 3-й день? 6-й день? 9-й день? 12-й день?

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. В первый день 3*36=108 игрушек. Каждый день на 15% больше, т.е.*1,15. Суммарный выпуск коробок, это видимо сколько их произвели за 3,6,9,12 дней. Считаем количество игрушек, которое будет у нас числом не целым, берем его целую часть (trunc) и делим через div на 36, получаем количество полных коробок. Проверял в Excel, все сходится. Приложение: uses crt; var kor,i,j:word; igr,sum:real; begin clrscr; igr:=108;sum:=108; for i:=2 to 12 do begin igr:=igr*1.15; sum:=sum+igr; if i mod 3=0 then writeln('Kolichestvo korobok za ',i,' dn=',trunc(sum) div 36); end; writeln; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 10:31

Вопрос № 133.608

о наипрекраснейшие из намлучших!!!помолгите!!!!! В ЭВМ вводятся по очереди координаты n точек. Определить, сколько из них попадет в кольцо с внутренним радиусом R1 и внеш- ним R2. Блок-схема.

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

Отвечает: -=Dr. Штопор=- Здравствуйте, Азаркина Полина Александровна! Помню, подобная задача была на районной олимпиаде по программированию :) Ключ к решению - уравнение окружности (курс геометрии за 9 класс). По координатам точки можно определить радиус окружности с центром (0;0) на которой она лежит. Условие попадания в кольцо - радиус окружности, на которой лежит точка находится в пределах от r1 до r2. Количество точек N определяется как константа в начале программы. Удачи! ____________________________ Tantum possumus, quantum scimus Приложение: program p133608; const N=15; var r1,r2:real; var x,y:array [1..N] of integer; count:word; Begin count:=0; write('(Внутр) R1='); readln(r1); write('(Внешн) R2='); readln(r2); for i:=1 to N do begin write('x',i,'='); read(x[i]); write(' y',i,'='); read(y[i]); if (sqr(x[i]) + sqr(y[i]) < sqr(r2)) and (sqr(x[i]) + sqr(y[i]) > sqr(r1)) then inc(count); end; write('В кольцо попало ',count,' точек'); end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 22.04.2008, 16:07

Вопрос № 133.612

плиз молю о помощиии: Протабулировать функцию(f)=6-(ax-(bx в кубе)и все выражение в скрбках в квадрате. для начальных условий: а=1, b=0.6 и для x ∈ [− 4, 7] с шагом 0.5.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. Приложение: uses crt; var a,b,x,y,dx:real; begin clrscr; a:=1;b:=0.6;x:=-4;dx:=0.5; while x<=7 do begin y:=6-sqr(a*x-b*x*x*x); writeln('x=',x:4:1,' y=',y:8:1); x:=x+dx; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 13:39

Вопрос № 133.617

доброй ночи , помогите составить программу: Пользователь вводит через пробел свое имя, отчество и фамилию. Программа определяет во введенной строке имя и отчество и приветствует пользователя.

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

Отвечает: -=Dr. Штопор=- Снова здравствуйте, Азаркина Полина Александровна! Ход решения таков: вырезаем последнее слово (с конца строки ищем пробел и обрезаем, начиная с него), затем выводим строку без последнего слова. Это и есть имя и отчество. ____________________________ Tantum possumus, quantum scimus Приложение: program p133617; var s:string; p,i:byte; BEGIN writeln('Введите имя, отчество и фамилию через пробел'); readln(s); for i:=length(s) downto 1 do if s[i]=' ' then begin p:=i; break; end; delete(s,p,length(s)-p+1 ); writeln('Здравствуйте, ',s,'!'); end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 22.04.2008, 16:28

Вопрос № 133.619

помогите пожалуста составить программу которая будет выполнять следующее: С клавиатуры задаётся строка. Требуется преобразовать строку так, чтобы цифры были продублированы.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. Просматриваем строку с конца, если находим цифру, вставляем ее еще раз. Приложение: uses crt; var s:string; i:integer; begin clrscr; write('Stroka: ');readln(s); i:=1; for i:=length(s) downto 1 do begin if s[i] in ['0'..'9'] then begin insert(s[i],s,i+1); end; end; writeln(s); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 15:02

Вопрос № 133.620

составить программу которая сможет: Посчитать количество слов во введенной строке символов, начи- нающихся с «Т» или «т».

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. Чтобы по одному принципу определять начало слова, добавим в начало строки пробел. Затем если s[i]-'т' или 'Т', а s[i-1]-пробел, то считаем слово. Приложение: uses crt; var s:string; i,k:integer; begin clrscr; write('Vvedite stroku:'); readln(s); s:=' '+s; k:=0; For i:=1 to length(s) do if ((s[i]='т')or(s[i]='T'))and(s[i-1]=' ') then k:=k+1; writeln('k=',k); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 15:26

Вопрос № 133.621

зДРАВСТВУЙТЕ УВАЖАЕМЫЕ ЭКСПЕРТЫ!!)_пОМОГИТЕ ПОЖАЛУЙСТА РЕШИТЬ ЗАДАЧКУ В Pascal: Отсотрировать массив вещественных чисел методом обмена. Построить блок-схему сортировки.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, LedyAG! В приложении программа, которая выполняет сортировку и подсвечивает элементы которые обменивались, т.е. показывает механизм работы метода Удачи! Приложение: uses crt; const n=9; type mass=array[1..n]of real; var a:mass; i:integer; {процедура будет вызыватся рекурсивно} procedure Sort(var aa:mass); var x:integer; j:real; begin {запускаем цикл проверки} for x:=1 to n-1 do if aa[x]>aa[x+1] then begin {обмениваем соседние элементы массива} j:=aa[x]; aa[x]:=aa[x+1]; aa[x+1]:=j; {вывод для контроля} for i:=1to n do begin {только для подсветки перестановок} if (i=x)or(i=(x+1)) then TextColor(15); write(aa[i]:8:4); TextColor(7); end; writeln; {вызываем саму себя с новым расположением элементов массива} Sort(aa); end; {сортировка закончилась} end; begin randomize; {массив создаeтся с помощью генератора случайных чисел и выводятся сразу} for i:=1 to n do begin a[i]:=30*random; write(a[i]:8:4); end; writeln; writeln; {сортируем массив} Sort(a); writeln; {выводим результат сортировки массива} for i:=1 to n do write(a[i]:8:4); writeln; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.625

Здравствуйте! Помогите пожалуйста решить эти две задачи: 1.Дана какая-нибудь строка.В строке надо заменить буквы 'abcd' на 'abc'. 2.Дана строка.В строке надо найти сколько слов начинается с первой буквы первого слова. У меня никак не получается,а завтра уже сдавать.Заранее благодарна!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Evela! Решение задач, если еще нужны, в приложении. Там довольно все просто, одни названия процедур и функций. Приложение: Задача 1. program q133625_1; uses crt; var s:string;i:integer; begin clrscr; writeln('stroka:');readln(s); for i:=1 to length(s) do if (s[i]='a')and(s[i+1]='b')and(s[i+2]='c')and(s[i+3]='d') then begin delete(s,i+3,1); {удаляем 4-ый символ} end; write(s); readln; end. Задача 2. program q133625_2; uses crt; var s:string;i,k:integer; begin clrscr; writeln('stroka:');readln(s); k:=0; for i:=2 to length(s) do {если буква после пробела=первой букве, то +1} if (s[i]=s[1])and(s[i-1]=' ') then begin k:=k+1;; end; write('Kol takih slov=',k); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 18:57 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!

Вопрос № 133.647

Уважаемые эксперты!помогите пожалуйста в решении следующей задачи: Дан одномерный массив числовых значений, насчитывающий N элементов.Сумму элементов целочисленного массива вставить на место, указанное первым элементов массива. Огромное спасибо!)

Отправлен: 22.04.2008, 18:33 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Семенов Константин Андреевич Здравствуйте, Igor lukashov! const n=100; var s: integer; i: integer; m: array[1..n]of integer; begin randomize; for i:=1 to n do begin m[i]:=random(n); s:=s+m[i]; end; m[m[1]]:=s; for i:=1 to n do write(m[i],' '); end.

Ответ отправил: Семенов Константин Андреевич (статус: 1-ый класс) Ответ отправлен: 22.04.2008, 18:53 Оценка за ответ: 3

Отвечает: SHERRY Здравствуйте, Igor lukashov! Возможно мой вариант Вам больше подойдёт. Можно, конечно, использовать динамический массив, но, думаю, здесь можно обойтись и так. Смотрите код в приложении. Приложение: const k = 999; var ms: array [1..k] of integer; i, sum, n: integer; begin write('Input N '); readln(n); sum:=0; for i:=1 to n do begin write('Input ms[', i, ']: '); readln(ms[i]); sum:=sum+ms[i]; end; writeln; if ms[1] > n then writeln('Cannot insert sum on ', ms[1], ' position') else begin ms[ms[1]]:=sum; for i:=1 to n do write(ms[i]:5); end; readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 7-ой класс) Ответ отправлен: 23.04.2008, 08:32

Вопрос № 133.653

Уважаемые эксперты!помогите пожалуйста в решении следующей задачи: Дан одномерный массив числовых значений, насчитывающий N элементов.Сумму элементов целочисленного массива вставить на место, указанное первым элементов массива. При этом сделать так,что бы N задавать самому. Огромное спасибо!)...

Отправлен: 22.04.2008, 19:12 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станислав Васильевич Здравствуйте, Igor lukashov! Программа в приложении Для того чтоб программа могла работать с разным розмером массива я использую в ней использует работу с динамической памятю. Приложение: Type Tdinamik=array[0..0] of integer; Var M:^Tdinamik; N,i:word; sum:Integer; Begin New(m); Write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® Ґ«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ: '); Readln(n); Writeln('‡ Ї®«­ЁвҐ ¬ ббЁў'); For i:=1 to n do Readln(m^[i]); For i:=1 to n do Sum:=m^[i]+sum; i:=1; M^[m^[i]]:=sum; Writeln('m[1]= ',sum); Dispose(m); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 6-ой класс) Ответ отправлен: 22.04.2008, 23:22

Отвечает: Пупорев Юрий Борисович Здравствуйте, Igor lukashov! Поскольку основная часть задачи в предыдущем ответе не решена (Сумму элементов целочисленного массива вставить на место, указанное первым элементов массива. ), привожу свой вариант решения. Код в приложении. Приложение: uses crt; var a:array[1..50]of integer; n,i,sum,k:integer; begin clrscr; randomize; write('Vvedite razmernost massiva= '); readln(n); writeln('Ishodny massiv:'); sum:=0; for i:=1 to n do begin a[i]:=random(n)+1; sum:=sum+a[i]; write(a[i],' '); end; writeln; k:=a[1]; for i:=n downto k do a[i+1]:=a[i];{сдвигаем все элементы с номера к до n вправо на 1} a[k]:=sum; writeln('Rezultat:'); for i:=1 to n+1 do {выводим на один элемент больше} write(a[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 20:18

Вопрос № 133.661

Уважаемые эксперты!очень надо решить следующее: выполнить обработку элементов квадратной матрицы А, имеющий N строк и N столбцов. найти сумму элементов, стоящих на главной диагонали, и сумму элементов, стоящих на побочной диагонали. Помогите,если не сложно.....спасибо)

Отправлен: 22.04.2008, 20:36 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Igor lukashov! Программа простая, поэтому комментариев не много. Удачи! Приложение: const n=5; var a:array[1..n,1..n]of integer; x,y,z:integer; begin {генерируем с помощью случайного генератора и выводим} randomize; for x:=1 to n do begin for y:=1 to n do begin a[x,y]:=random(99); write(a[x,y]:4); end; writeln; end; {сбрасываем сумму} x:=0; y:=0; for z:=1 to n do begin inc(x,a[z,z]);{главная диагональ} inc(y,a[z,n-z+1]);{побочная диагональ} end; writeln(x:5,y:5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Шемет Станислав Васильевич Здравствуйте, Igor lukashov! Программа в приложении Удачи!!! Приложение: Const N=10; var M:array[1..n,1..n] of integer; I,j:integer; sum,sum1:integer; Procedure Obrabotka; Begin sum:=0; sum1:=0; For i:=1 to n do Begin sum:=m[i,i]+sum;(*Главная диагональ*) sum1:=sum1+m[i,n-i+1];(*Побочная диагональ*) end; end; Begin Randomize; For i:=1 to n do For j:=1 to n do Readln(m[i,j]); Obrabotka; writeln(sum); Writeln(sum1); readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 6-ой класс) Ответ отправлен: 22.04.2008, 23:06

Вопрос № 133.689

Срочно, помогите, пожалуйста, решить задачку. Надо проверить пример на корректность. Пример находится в строке, пример на сложение. Например, 1+1=2 'yes' 2+2=3 'no' Просьба не использовать всяких процедур и умных функций типа апкейсы всякие и т.д. Спасибо.

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

Отвечает: Семенов Константин Андреевич Здравствуйте, SancheZ549! Считываешь сначала первую цифру, потом вторую, третью и проверяешь. Приложение: var s,ss: string; c1,c2,c3: integer; begin writeln('Введите строку'); readln(s); ss:=s[1]; c1:=strtoint(ss); ss:=s[3]; c2:=strtoint(ss); ss:=s[5]; c3:=strtoint(ss); if c1+c2=c3 then writeln('Yes') else Writeln('No'); readln(); end.

Ответ отправил: Семенов Константин Андреевич (статус: 1-ый класс) Ответ отправлен: 23.04.2008, 03:53 Оценка за ответ: 4 Комментарий оценки: А действительно, если число не из одного знака?

Отвечает: SHERRY Здравствуйте, SancheZ549! Мой пример распознает сложение, вычитание, умножение, деление и возведение в степень. Строку с примером записывайте в переменную s. Удачи! Приложение: const s='2^2=4'; mn = ['0'..'9']; var a,b,i,rez: integer; tmp: string; oper: char; begin tmp:=''; i:=1; while s[i] in mn do { nahodim v stroke 1-e 4islo } begin tmp := tmp + s[i]; inc(i); end; a:=StrToInt(tmp); oper:=s[i]; { opredelyaem operator (znak) } tmp:=''; inc(i); while s[i] in mn do { nahodim v stroke 2-e 4islo } begin tmp := tmp + s[i]; inc(i); end; b:=StrToInt(tmp); tmp:=''; inc(i); while s[i] in mn do { nahodim v stroke 3-e 4islo } begin tmp := tmp + s[i]; inc(i); end; { writeln(a:6, b:6, rez:6); najdennie 4isla v stroke } rez:=StrToInt(tmp); write(s, ' '); case oper of { proverka pravilnosti } '+': write(a+b=rez); '-': write(a-b=rez); '*': write(a*b=rez); '/': write(a/b=rez); '^': write(exp(a* ln(b))=rez); end; readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 7-ой класс) Ответ отправлен: 23.04.2008, 08:10 Оценка за ответ: 5 Комментарий оценки: Спасибо!

Вопрос № 133.717

Здравствуйте, помогите пожалуйста с задачками=)) 1. Дана действительная матрица размера n*m, все элементы которой различны. В каждой строке выбирается элемент с наименьшим значением. Затем среди этих чисел выбирается наибольшее, указать индексы элемента с найденным значением. Отсортировать матрицу по убыванию. 2. Информация о школьниках хранится в следующем порядке: фамилия, имя (и отчество), пол, год поступления, класс, итоговые оценки за год по семи предметам. Вывести на экран фамилии тех школьников, которые получат оценку по прилежанию «неуд». 3. Информация о расходе средств по университету хранится в следующем виде: фамилия подотчётного лица, наименование, дата покупки, цена, единица измерения, количество, наличие копии чека. Вывести на экран информацию о товаре на определенный период в формате: наименование товара, общее количество товара этого наименования, сумма потраченных средств. ОГРОМНОЕ СПАСИБО=)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Осипова Анна Олеговна! Был вот от Вас такой вопрос: Бесплатный вопрос № 130946 / КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal Текст вопроса: Здрасти, а помогите пож. с задачками=))) 1) Определить, во введенной строке есть десятичное число? Сколько чисел было введено? Какое из них наибольшее? 2) В двумерном массиве переставить местами элементы первой и последней строки. 3)Дана действительная матрица размера n*m, все элементы которой различны. В каждой строке выбирается элемент с наименьшим значением. Затем среди этих чисел выбирается наибольшее, указать индексы элемента с найденным значением. Отсортировать матрицу по убыванию. Спасибо=))) Отправитель: Осипова Анна Олеговна Вопрос отправлен: 07.04.2008, 10:10 Третья задача один к одному совпадает с первой задачей сегодняшнего вопроса. Я не понимаю для чего я Вам решал ее в прошлый раз, тратил время на решение, на ответ. Мне конечно не трудно еще раз выложить это решение, но ... обидно как-то. Приложение: Задача 1. uses crt; const n=5; m=6; var a:array[1..n,1..m]of integer; mn:set of byte; {множество используем для получения неповторяющихся чисел} b:array[1..n*m]of integer; {вспомогательный линейный массив для сортировки матрицы} i,j,min,max,imin,jmin,imax,jmax,k,x:integer; begin clrscr; mn:=[]; randomize; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin {заполняем матрицу случайными неповторяющимися числами от 1 до 30} repeat a[i,j]:=random(n*m)+1; until not (a[i,j] in mn); include(mn,a[i,j]); write(a[i,j]:4); end; writeln; end; readln; {Поиск максимального среди минимальных в строках} max:=0; for i:=1 to n do begin min:=a[i,1];jmin:=1; for j:=1 to m do if a[i,j]<min then begin min:=a[i,j];{минимальный в строке} jmin:=j; end; if min>max then begin max:=min; {если в сл.строке мин >, то max присваиваем ему} imax:=i;{номер строки} jmax:=jmin; {номер столбца} end; end; writeln('max=',max,' imax=',imax,' jmax=',jmax); readln; {разворачиваем матрицу в линейный массив} k:=0; for i:=1 to n do for j:=1 to m do begin k:=k+1; b[k]:=a[i,j]; end; {Сортируем массив по убыванию} for i:=1 to k-1 do for j:=1 to k-1 do if b[j]<b[j+1]then begin x:=b[j]; b[j]:=b[j+1]; b[j+1]:=x; end; {Сворачиваем массив обратно в матрицу в отсортированном виде} writeln('Sortironka:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=b[j+m*(i-1)]; write(a[i,j]:3); end; writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 23.04.2008, 21:59 Оценка за ответ: 5

Вопрос № 133.718

Здравствуйте, уважаемые эксперты! Помогите мне пожалуйста решить задачу по РГЗ: 1. Обработка матриц. Дана вещественная матрица A(n,m). Отсортировать элементы матрицы по строкам, используя сортировки: - пирамидальная сортировка; - простым выбором. а) Разработать программу, которая в заданной действительной квадратной матрице порядка n находит наибольший по модулю элемент и форми-рует новую квадратную матрицу порядка (n – 1) путем выбрасывания из исходной матрицы строки и столбца, на пересечении которых расположен элемент с найден-ным значением. б) Даны две целочисленные матрицы A(k,l) и D(l,c). Найти значение выражения: С=A*D+A*D. Результат инвертировать. Заранее спасибо. Очень жду вашей помощи.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Шелуфина Екатерина Викторовна! Решение задачи под литерой а) с пояснениями в приложении. Приложение: program q133718a; uses crt; const n=6; var i,j,imax,jmax:integer; a:array[1..n,1..n]of real; max:real; begin clrscr; randomize; {создаем и выводим на экран исходную матрицу} writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20)+random-10; write(a[i,j]:6:1); end; writeln; end; readln; {ищем максимальный по модулю элемент, номер строки и столбца, где он расположен} max:=abs(a[1,1]);imax:=1;jmax:=1; for i:=1 to n do for j:=1 to n do if (abs(a[i,j]))>max then begin max:=abs(a[i,j]); imax:=i; jmax:=j; end; writeln('max=',max:3:1,' imax=',imax,' jmax=',jmax); readln; {удаляем столбец, сдвигая все элементы в строках от индекса jmax+1 до n на одну позицию влево} for i:=1 to n do for j:=jmax to n-1 do begin a[i,j]:=a[i,j+1]; end; {удаляем строку, сдвигая все элементы в столбцах от индекса шmax+1 до n на одну позицию вверх } for j:=1 to n do for i:=imax to n-1 do begin a[i,j]:=a[i+1,j]; end; {выводим «укороченную» матрицу на экран} writeln('Rezultat:'); for i:=1 to n-1 do begin for j:=1 to n-1 do write(a[i,j]:6:1); writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 24.04.2008, 07:15

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