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

Выпуск № 620
от 02.04.2008, 03:35

Вопрос № 129.238

Дано целое число M в двоичной системе счисления, вычислить M+1 в двоичной системе. Например написать 8 в виде 1000, потом 9 в виде 1001. Немного подправлен перевод. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 27.03.2008, 06:08

Отправлен: 27.03.2008, 05:37 Вопрос задала: Nargis Haydarova (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Nargis Haydarova! Программа в приложения. Удачи! Приложение: uses crt; const n=64; var a:array[0..n]of integer; b,d:integer; c:char; begin write('Enter N:'); {сбрасываем переменные} for b:=0 to n do a[b]:=0; d:=0; repeat c:=ReadKey; {реагируем только на 0 или 1} if (c='0')or(c='1')then begin {выводим цифру} write(c); {сдвигаем старшие разряды} for b:=n downto 0 do a[b]:=a[b-1]; {записываем в младший разряд} a[0]:=ord(c)-ord('0'); {увеличиваем счетчик разрядов} inc(d); end; until(c=chr(13))or(d=n); writeln; {увеличиваем на 1 и корректируем результат} inc(a[0]); for b:=1 to n do begin inc(a[b],(a[b-1]div 2)); a[b-1]:=a[b-1]mod 2; end; {выводим результат пропупуская начальные 0} write('Result :'); d:=0; for b:=n downto 0 do begin inc(d,a[b]); if d>0 then write(a[b]); end; ReadKey; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Louken Здравствуйте, Nargis Haydarova! Программа с комментариями в приложении: Приложение: program z; uses Crt; var m: array[1..100] of byte; k, i: integer; s: string; begin ClrScr; Writeln('Write M: '); Readln(s); k:=Length(s); {Длинна строки, она же количество цифр в числе} {Преобразовываем строку в массив цифр} for i:=1 to k do begin if s[k-i+1]='0' then m[i]:=0 else if s[k-i+1]='1' then m[i]:=1 else begin {Введен недопустимый символ} Writeln('Char error'); Readln; Exit; {Выходим из программы} end; end; {Увеличиваем младший разряд на 1} Inc(m[1]); i:=1; {Пробегаем по всему числу, и исправляем результат} While m[i]>1 do begin m[i]:=m[i]-2; Inc(i); Inc(m[i]); end; {Если в ответе получили больше цифр чем было} {Например было 111 стало 1000, на одну цифру больше} if m[k+1]>0 then Inc(k); {Выводим ответ, числа располагаются в обратном порядке} for i:=k downto 1 do Write(m[i]); Readln; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 27.03.2008, 19:24 Оценка за ответ: 5

Вопрос № 129.239

Дано треугольник с координатами А(х1,у1), В(х2,у2) и С(х3,у3). Принадлежит ли или нет к этому треуголнику точка Р(х,у).

Отправлен: 27.03.2008, 06:03 Вопрос задала: Nargis Haydarova (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Nargis Haydarova! Программа в приложении. Решение основано на вычислении площадей: если точка P лежит внутри треугольника ABC, то сумма площадей треугольников ABP, ACP, BCP равна площади треугольника ABC. Вычисление идет чере переменные действительного типа, поэтому необходимо указать точность, с которой будут сравниваться площади. Точность в данной программе определяется константой exactness: const exactness = 100000; { точность вычислений } Удачи! Приложение: function len(x1,y1,x2,y2:real):real; begin len := sqrt(sqr(x1-x2)+sqr(y1-y2)); end; function square(x1,y1,x2,y2,x3,y3:real):real; var p, a,b,c : real; begin a := len(x1,y1,x2,y2); b := len(x2,y2,x3,y3); c := len(x3,y3,x1,y1); p := ( a + b + c )/2; square := sqrt(p*(p-a)*(p-b)*(p-c)); end; const exactness = 100000; { точность вычислений } var x1,x2,x3,y1,y2,y3 : real; x,y : real; s1,s2 : real; begin Write('Vvedire xA: '); readLn(x1); Write('Vvedire yA: '); readLn(y1); Write('Vvedire xB: '); readLn(x2); Write('Vvedire yB: '); readLn(y2); Write('Vvedire xC: '); readLn(x3); Write('Vvedire yC: '); readLn(y3); Write('Vvedire xP: '); readLn(x); Write('Vvedire yP: '); readLn(y); s1 := round(square(x1,y1,x2,y2,x3,y3)*exactness); s2 := round((square(x1,y1,x2,y2,x,y) + square(x1,y1,x,y,x3,y3) + square(x,y,x2,y2,x3,y3))*exactness); if s1 = s2 then WriteLn('Prinadlezhit') else WriteLn('NE prinadlezhit'); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 08:31 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Nargis Haydarova! Есть несколько геометрических способов определения принадлежности точки фигуре. Мне более понятен и потому нравится следующий способ. Если точка находится внутри треугольника, то сумма площадей трех маленьких треугольников, образованных точкой Р с двумя вершинами треугольника, будет равна площади большого треугольника. В противном случае нет. Поскольку нам придется шесть раз определять длину стороны и четыре раза считать площадь треугольника, оформим эти вычисления функциями. Функцией логического типа оформим и определение результата. Поскольку при вычислении координат, длин линий и площадей образуются вещественные числа, то их равенство можно установить лишь приближенно. Поэтому мы вводим костанту-погрешность. Длины линий определяем известным способом, площади треугольников по формуле Герона, как то привычнее, хотя есть и другие способы. Для тестирования программы можете ввести такие наборы чисел: а)1,1,8,1,1,8,2,2-будет внутри б)1,1,8,1,1,8,6,6-будет снаружи Вроде все. Удачи! Код в приложении. Приложение: uses crt; var ax,ay,bx,by,cx,cy,px,py:real; function Dl(ax,ay,bx,by:real):real;{длина} begin Dl:=sqrt(sqr(ax-bx)+sqr(ay-by)); end; function Strg(ax,ay,bx,by,cx,cy:real):real;{площадь} var p,a,b,c:real; begin a:=Dl(cx,cy,bx,by); b:=Dl(cx,cy,ax,ay); c:=Dl(ax,ay,bx,by); p:=(a+b+c)/2; Strg:=sqrt(p*(p-a)*(p-b)*(p-c)); end; function Inside(ax,ay,bx,by,cx,cy,px,py:real):boolean;{внутри?} const pogr=1.000001; var s,s1,s2,s3:real; begin Inside:=true; s:=Strg(ax,ay,bx,by,cx,cy); s1:=Strg(ax,ay,bx,by,px,py); s2:=Strg(bx,by,cx,cy,px,py); s3:=Strg(ax,ay,cx,cy,px,py); if s*pogr>s1+s2+s3 then Inside:=true else Inside:=false; end; begin clrscr; write('ax=');readln(ax); write('ay=');readln(ay); write('bx=');readln(bx); write('by=');readln(by); write('cx=');readln(cx); write('cy=');readln(cy); write('px=');readln(px); write('py=');readln(py); if Inside(ax,ay,bx,by,cx,cy,px,py) then writeln('Prinadlegit') else writeln('Ne orinadlegit'); readln end.

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

Вопрос № 129.240

Дано круг при нажатия клавиша "g" он двигался по горизонтали и обратно до нажатие кнопки "S",при нажатие "V" по вертикали и обратно до нажатие кнопки "S".

Отправлен: 27.03.2008, 06:09 Вопрос задала: Nargis Haydarova (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Louken Здравствуйте, Nargis Haydarova! Программа с комментариями в приложении: Приложение: program z; uses Graph, Crt; const radius = 100; {радиус окружности} var grDriver,grMode : integer; ch: char; {символ нажатой клавиши} x,y,d: integer; {координаты точки и смещение} direction: boolean; {направление, true - по горизонтали} begin {инициализируем графический режим} grDriver:=VGA; grMode:=VGAHi; {путь к папке BGI с драйвером поставьте свой} InitGraph(grDriver,grMode,'D:progTP7BGI'); {Задаем координаты окружности} x:=320; y:=240; d:=5; direction:=true; Repeat Delay(200); {Закрашиваем окружность} SetColor(0); Circle(x,y, radius); if direction then begin x:=x+d; if (x<=radius) or (x>=640-radius) then d:=-d; end else begin y:=y+d; if (y<=radius) or (y>=480-radius) then d:=-d; end; {Рисуем окружность} SetColor(14); Circle(x,y, radius); if KeyPressed then begin ch:=UpCase(ReadKey); case ch of 'G': direction:=true; 'S': direction:=false; end; end; Until ch=#27; {Выход по нажатию Escape} {Выходим из графического режима} CloseGraph; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 27.03.2008, 20:34 Оценка за ответ: 5

Вопрос № 129.252

Подсчитать в предложении количество слов,начинающихся с прописных. Использовать цикл while.

Отправлен: 27.03.2008, 08:23 Вопрос задала: Лиманская Юлия Вадимовна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Лиманская Юлия Вадимовна! Программа в приложении. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; const symbols = ',.:!?;'; { znaki prepinaniya } letters = ['A'..'Z']; var s : string; i, c : integer; begin WriteLn('Vvedite predlozhenie:'); ReadLn(s); { change all symbols to spaces } for i := 1 to length(s) do if (pos(copy(s,i,1),symbols)>0) then begin insert(' ',s,i); delete(s,i+1,1); end; While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); s := trim(s); s := ' '+s; c := 0; while pos(' ',s) >0 do begin if s[pos(' ',s)+1] in letters then inc(c); delete(s,pos(' ',s),1); end; WriteLn('S propisnoj bukvy nachinaetns ',c, ' slov'); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 08:42 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Код в приложении. Для удобства подсчета в начало строки добавлен пробел. Остальное вроде все понятно. Приложение: uses crt; const pr=['A'..'Z','А'..'Я','Ё']; var a:string; i,k:integer; begin clrscr; write('a: ');readln(a); i:=2; a:=' '+a;k:=0; while i<=length(a)do begin if((a[i] in pr))and(a[i-1]=' ')then begin k:=k+1; inc(i); end; inc(i); end; writeln('Kolichestvo propisnyh=',k); readln end.

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

Вопрос № 129.255

Привет, помогите пожалуйста решить.... 1. Дан массив целых чисел, содержащий 20 элементов. Записать в этом же массиве сначала все отрицательные числа, а затем все остальные, сохраняя порядок их следования. 2. Отсортировать массив вещественных чисел методом с простыми включениями. спасибо=)

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Осипова Анна Олеговна! Первая программа в приложении. Сдвигает отрицательные элементы с начало массива сохраняя последовательность следования всех остальных, при этом порядок следования отрицательных также сохраняется. Удачи! Приложение: const N = 20; var A : array[1..N] of integer; function fneg(k:integer):integer; { ищет первое отрицательное число начиная с k-ого элемента } var i,res : integer; begin i := k; res := -1; while (i <= N)and(res=-1) do begin if A[i] < 0 then res := i; inc(i); end; fneg := res; end; procedure move(i,k:integer); { сдвигает k элементов массива начиная i-ого на одну позицию вправо на i-ую позицию записывается (i+k)-ый элемент } var j, tmp : integer; begin tmp := A[k]; for j := k-1 downto i do A[j+1] := A[j]; A[i] := tmp; end; var i, k : integer; begin randomize; for i := 1 to N do begin A[i] := random(30)-random(20); Write(A[i]:4); end; WriteLn; i := 1; k := fneg(i); while k <> -1 do begin move(i,k); inc(i); k := fneg(i); end; for i := 1 to N do begin Write(A[i]:4); end; ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 09:30

Отвечает: Зенченко Константин Николаевич Здравствуйте, Осипова Анна Олеговна! 2-я задача в приложении. Посмотрите описание алгоритма. Удачи! Приложение: type TReal=array[1..10]of real; var a:TReal; c,i,j:integer; b:real; begin {создаем массив} randomize; for i:=1 to 10 do begin a[i]:=random(100)/(1+random(10000)); write(a[i]:7:4); end; writeln; {сортируем массив} for i:=1 to 9 do begin for j:=i+1 to 10 do if a[i]>a[j] then begin b:=a[i]; a[i]:=a[j]; a[j]:=b; end; {выводим для контроля} for c:=1 to 10 do write(a[c]:7:4); writeln; end; {выводим результат} for i:=1 to 10 do write(a[i]:7:4); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 27.03.2008, 12:50 Оценка за ответ: 5

Вопрос № 129.261

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ahmadullina Mila Raufovna! Создайте в директории BIN простой текстовый файл, заполните его в несколько строк, например цифрами, они при смене кодировки не меняются.Присвойте ему имя и сохраните его. Далее будете работать с ним, как написано в коде программы в приложении. После выполнения программы указанная строка изменится на заданную. Приложение: uses crt; var f:text; s:array[1..50]of string; s1:string; n,i,k:integer; begin clrscr; write('s1: ');readln(s1); write('k=');readln(k); assign(f,'stroka.txt'); reset(f);n:=0; while not eof(f)do begin n:=n+1; readln(f,s[n]); end; close(f); s[k]:=s1; rewrite(f); for i:=1 to n do begin writeln(f,s[i]); end; close(f); end.

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

Вопрос № 129.269

Здравствуйте уважаемые:) У меня снова возникли трудности с решение заданий..Помогите пожалуйста, вот задания : 1. Составить программу вычисления значения выражения S=1+sqrt(2)+sqrt(3)+sqrt(4)+...sqrt(n) при 1<=n<=100 2. Составить программу вычисления значения выражения cos1+cos3+cos5+...+cos(2n-1), при заданном n. Все задачи нужно решить в среде Pascal , используя циклы с параметром.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Гуреев Леонид Вадимович! Поскольку задачи очень простые и короткие, я объединил их в одной. Код в приложении. Приложение: uses crt; var n,i:integer; s1,s2:real; begin clrscr; write('n=');readln(n); s1:=0; for i:=1 to n do begin s1:=s1+sqrt(i); end; writeln('Summa kornei=',s1:5:3); readln; s2:=0; for i:=1 to n do begin s2:=s2+cos(2*i-1); end; writeln('Summa kosinusov=',s2:5:3); readln; end.

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

Вопрос № 129.288

Уважаемые Эксперты. Помогите пожалуйста с написание программ: 1. Задано n троек чисел a, b, c. Вводя их по очереди интерпретируя как длины сторон треугольника, записать в три одномерных массива a, b и c. Необходимо определить, сколько троек может быть исполь- зовано для построения треугольника. 2. Дан массив целых чисел, содержащий 20 элементов. Записать в этом же массиве сначала все, значения которых больше 100, затем все ос- тальные, сохраняя порядок их первоначального следования. 3. Дан массив целых чисел, содержащий 25 элементов. Записать в этом же массиве сначала все числа, меньшие по модулю заданного с кла- виатуры значения, а затем все остальные, сохраняя порядок их сле- дования. 4. Отсортировать массив вещественных чисел методом обмена.

Отправлен: 27.03.2008, 12:31 Вопрос задал: Федосов Александр Иванович (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Федосов Александр Иванович! В приложении вторая и третья программы. Код у них практически одинаковый. Удачи! Приложение: =============================== Вторая задача =============================== const N = 20; var A : array[1..N] of integer; function f(k:integer):integer; { ищет первое число большее 100 начиная с k-ого элемента } var i,res : integer; begin i := k; res := -1; while (i <= N)and(res=-1) do begin if A[i] > 100 then res := i; inc(i); end; f := res; end; procedure move(i,k:integer); { сдвигает k элементов массива начиная i-ого на одну позицию вправо на i-ую позицию записывается (i+k)-ый элемент } var j, tmp : integer; begin tmp := A[k]; for j := k-1 downto i do A[j+1] := A[j]; A[i] := tmp; end; var i, k : integer; begin randomize; for i := 1 to N do begin A[i] := random(300); Write(A[i]:4); end; WriteLn; i := 1; k := f(i); while k <> -1 do begin move(i,k); inc(i); k := f(i); end; for i := 1 to N do begin Write(A[i]:4); end; WriteLn; ReadLn; end. =============================== Третья задача =============================== const N = 25; var A : array[1..N] of integer; T : integer; { вводимое максимальное значение } function f(k:integer):integer; { ищет первое число большее 100 начиная с k-ого элемента } var i,res : integer; begin i := k; res := -1; while (i <= N)and(res=-1) do begin if abs(A[i]) < T then res := i; inc(i); end; f := res; end; procedure move(i,k:integer); { сдвигает k элементов массива начиная i-ого на одну позицию вправо на i-ую позицию записывается (i+k)-ый элемент } var j, tmp : integer; begin tmp := A[k]; for j := k-1 downto i do A[j+1] := A[j]; A[i] := tmp; end; var i, k : integer; begin randomize; for i := 1 to N do begin A[i] := random(100); Write(A[i]:4); end; WriteLn; Write('Vvedite chislo: '); ReadLn(T); WriteLn; i := 1; k := f(i); while k <> -1 do begin move(i,k); inc(i); k := f(i); end; for i := 1 to N do begin Write(A[i]:4); end; WriteLn; ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 12:44 Оценка за ответ: 5 Комментарий оценки: Большое спасибо.

Отвечает: Костя Симанович Здравствуйте, Федосов Александр Иванович В приложении первая задача. проверяется условие все три числа должны быть больше нуля и сумма двух сторон больше третьей. Приложение: Program treug; Var a, b, c : array[1..100] of Real; i : integer; k, n : integer; Begin k := 0; writeln('Введите кол-во троек не более 100.'); readln(n); WriteLn('Введите стороны треугольника:'); for i := 1 to n do begin writeln(i, ' Тройка.'); Write('a = '); ReadLn(a[i]); Write('b = '); ReadLn(b[i]); write('c = '); readln(c[i]); end; for i := 1 to n do begin if ((a[i] > 0.0) and (b[i] > 0.0) and (c[i] > 0.0)) then if ((a[i] < b[i] + c[i]) and (b[i] < a[i] + c[i]) and (c[i] < a[i] + b[i])) then k := k + 1; end; writeln('Для построения треугольника может быть испльзовано = ', k, ' троек'); ReadLn; End.

Ответ отправил: Костя Симанович (статус: 2-ой класс) Ответ отправлен: 27.03.2008, 12:55 Оценка за ответ: 5 Комментарий оценки: Все отлично. Спасибо.

Отвечает: Зенченко Константин Николаевич Здравствуйте, Федосов Александр Иванович! 4-я задача в приложении. Вопросы по задаче задавайте в мини-форум. Удачи! Приложение: type TReal=array[1..10]of real; var a:TReal; i:integer; procedure sort(var aa:TReal); var j:integer; bb:real; begin for j:=1 to 9 do if aa[j]>aa[j+1]then begin {перестановка} bb:=aa[j]; aa[j]:=aa[j+1]; aa[j+1]:=bb; {вывод для контроля} for i:=1 to 10 do write(aa[i]:7:4); writeln; {была перестановка вызываемсаму себя с новыми значениями массива} sort(aa); end; end; begin {создаем массив и выводим} randomize; for i:=1 to 10 do begin a[i]:=random(100)/(1+random(10000)); write(a[i]:7:4); end; writeln; writeln; {сортируем} sort(a); {выводим результат} for i:=1 to 10 do write(a[i]:7:4); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Федосов Александр Иванович! В приложении решение задачи №1, самой, на мой взгляд, сложной. Признаком существования треугольника является то, что наибольшая сторона меньше суммы двух других сторон. На этом основании мы делаем функцию логического типа, проверяющую три числа на предмет возможности их быть сторонами треугольника. Далее в тройном цикле ищем количество таких совпадений. Я тестировал программу при небольших n, все работает. Поскольку я ограничен во времени, то использовал рандомный ввод чисел и тип Integer, чтобы легче тестировать. Вам наверное при оформлении нужно будет сделать ручной ввод данных и сменить Integer на Real, соответственно формат вывода данных на экран. Удачи! Приложение: uses crt; var a,b,c:array[1..50]of integer; n,i,j,m,k:integer; function Treug(a,b,c:integer):boolean; begin if(a>=b)and(a>=c)and(a<b+c) or (b>=a)and(b>=c)and(b<a+c) or (c>=a)and(c>=b)and(c<a+b) then Treug:=true else Treug:=false; end; begin clrscr; randomize; write('n=');readln(n); for i:=1 to n do begin a[i]:=random(10)+1; write(a[i],' '); end; writeln; for i:=1 to n do begin b[i]:=random(10)+1; write(b[i],' '); end; writeln; for i:=1 to n do begin c[i]:=random(10)+1; write(c[i],' '); end; writeln; readln; k:=0; for i:=1 to n do begin for j:=1 to n do begin for m:=1 to n do if Treug(a[i],b[j],c[m]) then begin k:=k+1; end; end; end; writeln('k=',k); readln end.

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

Вопрос № 129.295

Здравствуйте Уважаемые эксперты! Помогите мне решить задачу: Заменить все числа в строке на цифру 8: Формат ввода: 1+2+3+4+5+6+7+8+9+10+11=66 Формат вывода: 8+8+8+8+8+8+8+8+8+88+88=88

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Шорин Роман Игоревич! Вот пример, как это можно сделать. Это частный случай, а вообще надо организовать ввод. Код в прирложении. Приложение: uses crt; var s:string; i:integer; begin clrscr; s:='1+2+3+4+5+6+7+8+9+10+11=66'; for i:=1 to length(s) do if (s[i]<>'=')and(s[i]<>'+')then begin s[i]:='8'; end; writeln(s); readln end.

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

Отвечает: Шемет Станислав Васильевич Здравствуйте, Шорин Роман Игоревич! Программа в приложении. Удачи!!! Приложение: Var s:string; Procedure Rev; Var Temp:String; I:byte; Begin temp:=''; For i:=1 to Length(s) do If (s[i]>=#48)and(s[i]<=#57) then Temp:=temp+'8' else TEmp:=TEmp+s[i]; s:=Temp; end; Begin REadln(s); Rev; Writeln(s); REadln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 5-ый класс) Ответ отправлен: 27.03.2008, 13:34 Оценка за ответ: 5

Вопрос № 129.332

здарвствуте! невыходит зделать програму! помогите пожалуйсята! задача звучит так: пощитать z=(s1+s2)/(k1+k2) где s1, k1-самму и количесто положительных елементов масива y(n), a s2, k2-соответственно масива А(i), n,i<=50 задачу нужно зделать с помощью процедур и функцый и без использования RANDOMIZE! ЗАРАНИЕ СПАСИБО! Приложение:

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, коваль максим владимирович! Код с небольшими комментариями в приложении. Часто встречается writeln;- это для оформления. Приложение: uses crt; type mass=array[1..50]of real; var a,y:mass; n,i,j:integer; z:real; procedure Vvod(n:integer;var m:mass); begin for j:=1 to n do begin write('el[',j,']='); {ввод без Рандома} readln(m[j]); end; writeln; end; function Summ(n:integer;m:mass):real;{сумма по условию} var sm:real; begin sm:=0; for j:=1 to n do if m[j]>0 then begin sm:=sm+m[j]; end; Summ:=sm; end; function Kol(n:integer;m:mass):integer; var k:integer; { количество по условию} begin k:=0; for j:=1 to n do if m[j]>0 then begin k:=k+1; end; Kol:=k; end; begin clrscr; write('n=');readln(n); Vvod(n,y); writeln; write('i=');readln(i); Vvod(i,a); clrscr; writeln('Massiv Y:'); for j:=1 to n do write(y[j]:5:2); writeln; writeln('Massiv A:'); for j:=1 to i do write(a[j]:5:2); writeln; readln; {расчет по формуле с использованием функций и вывод} writeln('Z=',(Summ(n,y)+Summ(i,a))/(Kol(n,y)+Kol(i,a)):5:2); readln end.

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

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