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

Выпуск № 599
от 11.03.2008, 16:05

Вопрос № 126.116

Операторы условного перехода...Напишите плиз только в несокращённой форме а в полной плиз... 1) Проверьте, является ли сумма четырёх произвольных чисел, введённых с клавиатуры, чётным числом. 2) Для четырёх произвольных чисел, введённых с клавиатуры, выведите на экран соответствующие результаты. Если произведение второго и четвёртого чисел чётно, то выведите эти два числа и их произведение. Если сумма первого и третьего чисел будет больше 150, то выведите эту сумму и все четыре числа. Если выполняются одновременно два перечисленных условия, то выведите произведение второго и четвёртого чисел и сумму первого и третьего. Иначе, выведите эти четыре числа без изменения. Составьте соответствующие отладочные примеры и проверьте работу каждой программы.

Отправлен: 05.03.2008, 17:30 Вопрос задал: Danilka (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Marked One Здравствуйте, Danilka! В приложении рабочий код. 1) Число является четним если делится на 2 без остатка. проверить это можно такой конструкцией: (sum)=((sum div 2)*2). То есть если произведение суммы чисел разделенной на 2 без остатка равно сумме, то число четное. Приложение: {№1} program If_operator; var sum, x1, x2, x3, x4: Integer; {x1...x4-переменные для хранения чисел. sum-сумма этих чисел.} begin ReadLn(x1); //Ввод чисел с клавиатуры ReadLn(x2); ReadLn(x3); ReadLn(x4); sum:=x1+x2+x3+x4; //Складываем числа If (sum)=((sum div 2)*2) then {Если сумма четная, то выводим Yes, иначе No.} writeLn('Yes') else writeLn('No'); readln(x1); //Для того чтобы пользователь увидел рез-тат. end. {№2} program If_operator; var sum24, sum13, x1, x2, x3, x4: Integer; begin ReadLn(x1); ReadLn(x2); ReadLn(x3); ReadLn(x4); sum24:=x2*x4; sum13:=x1+x3; If ((sum24)=((sum24 div 2)*2)) and (sum13>150) then begin writeLn(x2*x4); writeln(x1+x3); end else if (sum24)=((sum24 div 2)*2) then begin writeln('x2*x4-Chetno'); writeln(x2); writeln(x4); end else if sum13>150 then begin WriteLn(Sum13); writeln(x1); WriteLn(x2); WriteLn(x3); WriteLn(x4); end else begin writeln(x1); WriteLn(x2); WriteLn(x3); WriteLn(x4); end; readln(x1); end.

Ответ отправил: Marked One (статус: 7-ой класс) Ответ отправлен: 05.03.2008, 18:59 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Danilka! Если првильно понял это запутанное условие, то код в приложении. Приложение: program q126116_1; uses crt; var a,b,c,d:integer; begin clrscr; write('a=');readln(a); write('b=');readln(b); write('c=');readln(c); write('d=');readln(d); if (a+b+c+d)mod 2=0 then writeln('chetnoe') else writeln('nechetnoe'); if b*d mod 2=0 then writeln('b=',b,' d=',d,' b*d=',b*d); if a+c>150 then writeln('sum=',(a+b+c+d),'a=',a,' b=',b,' c=',c,' d=',d); if (b*d mod 2=0) and (a+c>150) then writeln('b*d=',b*d,' a+c=',a+c) else writeln('a=',a,' b=',b,' c=',c,' d=',d); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 05.03.2008, 20:01 Оценка за ответ: 5

Отвечает: Попов Владимир Иванович Здравствуйте, Danilka! Решение обеих задачек в приложении. Протестированы, работают соответственно условию. Успехов. Приложение: program q126116; uses crt; var ch:char; x1,x2,x3,x4,s,k:integer; begin clrscr; repeat writeln; write(' Input any FOUR INTEGER numbers : '); readln(x1,x2,x3,x4); s:=x1+x2+x3+x4; k:=s mod 2; if k=0 then writeln(' The sum of inputed numbers : s = ',s,' - is couple !!!') else writeln(' The sum of inputed numbers : s = ',s,' - does not couple !!!'); writeln; write(' Again ? (y/n) ---> '); ch:=readkey; writeln; until ch='n'; end. {------------------------} program q126116_2; uses crt; var ch:char; x1,x2,x3,x4:integer; begin clrscr; repeat writeln; write(' Input any FOUR INTEGER numbers : '); readln(x1,x2,x3,x4); writeln; if ((x2*x4) mod 2 = 0) and not((x1+x3)>150) then writeln(' The multiply of the second & fours numbers : x2 * x4 = ',x2,' * ',x4,' = ',x2*x4); if ((x1+x3)>150) and not((x2*x4) mod 2 = 0) then begin writeln(' The summ of the first & third numbers : x1 + x3 = ',x1,' + ',x3,' = ',x1+x3); writeln(' The list of all inputed numbers is : ',x1,', ',x2,', ',x3,', ',x4,'.'); end; writeln; if ((x2*x4) mod 2 = 0) and ((x1+x3)>150) then begin writeln(' The multiply of the second & fours numbers : x2 * x4 = ',x2,' * ',x4,' = ',x2*x4); writeln(' The summ of the first & third numbers : x1 + x3 = ',x1,' + ',x3,' = ',x1+x3); end else writeln(' The list of all inputed numbers is : ',x1,', ',x2,', ',x3,', ',x4,'.'); writeln; write(' Again ? (y/n) ---> '); ch:=readkey; writeln; until ch='n'; end. --------- Physics forever !

Ответ отправил: Попов Владимир Иванович (статус: 3-ий класс) Ответ отправлен: 07.03.2008, 13:30 Оценка за ответ: 5

Вопрос № 126.135

Есть программа которая находит растояния между всеми точками на плоскости. Нужно чтобы она еще находила 2 самые ближние и 2 самые дальние точки. Приложение: Program points; const N = 4; M = N * (N - 1) div 2; Type PType = array[1..2] of single; ArType = array [1..N] of PType; dType = array[1..M] of single; Function Length(a, b : PType) : single; begin Length := sqrt(sqr(a[1] - b[1]) + sqr(a[2] - b[2])); end; Procedure Input (var P : ArType); var I : byte; begin for I := 1 to N do begin writeLn ('Enter coordinate X point',i,'='); readLn (P[I, 1]); writeLn ('Enter coordinate Y point',i,'='); readLn (P[I, 2]); end; end; procedure Calc(P : ArType; var Z : dType); var I, J, K : byte; A, B : PType; begin K := 0; for i := 1 to N - 1 do for j := i + 1 to N do begin inc(k); a[1] := p[i,1]; a[2] := p[i,2]; b[1] := p[j,1]; b[2] := p[j,2]; z[k] := Length(a, b); end; end; Procedure Output (Z : dType); var I : Byte; begin for i := 1 to M do writeLn(z[i]); readln; end; Procedure Work; var w:PType; r:ArType; t:dType; begin Input(r); Calc(r,t); Output(t); end; begin work; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Семин Алексей Юрьевич! Начал доделывать вашу прjграмму, запутался в массивах и сделал по своему, с использованием массивов записей. Программа нормально работает, красиво выдает результат. Обошелся без функций и процедур, поскольку они используются по одному разу и только перегружают программу. Другое дело, если их убрать в отдельный модуль. Но оформление ваше личное дело. Привожу код в приложении. Приложение: uses crt; type TPoint=record x,y:real;//точка и ее координаты end; Tlang=record //отрезок, его длина и номера крайних точек t1,t2:byte; dl:real; end; var a:array[1..20]of Tpoint;//массив точек b:array[1..190]of Tlang; //массив отрезков n,i,j,k,m,imin,imax:integer; max,min:real; begin clrscr; randomize; write('n=');readln(n); write(' ':4); //просто оформление for i:=1 to n do write(i:6); writeln; write('a[i].x'); for i:=1 to n do begin a[i].x:=random(20)+random-10; write(a[i].x:6:2); end; writeln; write('a[i].y'); for i:=1 to n do begin a[i].y:=random(20)+random-10; write(a[i].y:6:2); end; readln; k:=0; for i:=1 to n-1 do for j:=i+1 to n do begin k:=k+1; b[k].t1:=i; //номер первой точки b[k].t2:=j; //номер второй точки b[k].dl:=sqrt(sqr(a[j].x-a[i].x)+sqr(a[j].y-a[i].y));//длина end; min:=b[1].dl;imin:=1;max:=b[1].dl;imax:=1;//поиск минимального и for i:=2 to n*(n-1) div 2 do //максимального отрезков begin //и номеров точек на их концах if b[i].dl<min then begin min:=b[i].dl; imin:=i; end else if b[i].dl>max then begin max:=b[i].dl; imax:=i; end; end; writeln('samyj korotkij otrezok=',min:5:2,' tochki ',b[imin].t1,'-',b[imin].t2); writeln('samyj dlinnij otrezok=',max:5:2,' tochki ',b[imax].t1,'-',b[imax].t2); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 06.03.2008, 07:12

Вопрос № 126.156

Доброго всем времени суток! Помогите решить такую задачу: дано натуральное число n. Найти и вывести на экран макс и мин значения цифр этого числа. Заранее благодарен! Исправлены орфографические ошибки. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 06.03.2008, 05:30

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, XaciH! Программа в приложении. Удачи! Приложение: var n, k, min, max : longint; begin WriteLn('Vvedite N:'); ReadLn(n); k := n mod 10; n := n div 10; min := k; max := k; while n > 0 do begin k := n mod 10; n := n div 10; if k < min then min := k; if k > max then max := k end; WriteLn('max: ', max); WriteLn('min: ', min); ReadLn; end.

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

Отвечает: Костя Симанович Здравствуйте, XaciH! То же решение но с помощью repeat - until Удачи. Приложение: program chislo; var n, z : integer; imax: integer; imin: integer; begin writeln('Введите число'); readln(n); imax := 0; imin := 10; repeat z := n mod 10; {последняя цифра} n := n div 10; {это же число без последней цифры} if imax < z then imax := z; if imin > z then imin := z; until n = 0; writeln('Мин значение= ', imin); writeln('Макс значение = ', imax); readln; end.

Ответ отправил: Костя Симанович (статус: 1-ый класс) Ответ отправлен: 05.03.2008, 22:19

Отвечает: Пупорев Юрий Борисович Здравствуйте, XaciH! Чтобы можно было вводить числа не задумываясь о их длине, применим строковый тип. Решение в приложении. Приложение: program q126156; uses crt; var n:string; i:integer; max,min:char; begin clrscr; write('n=');readln(n); max:=n[1];min:=n[1]; for i:=1 to length(n) do begin if n[i]>max then max:=n[i] else if n[i]<min then min:=n[i]; end; write('max=',max,' min=',min); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 05.03.2008, 22:20

Вопрос № 126.186

Здравствуйте уважаемые эксперты. Помогите пожалуйста решить задачу. Написать функцию, которая вычисляет среднее арифметическое элементов непустого списка.

Отправлен: 06.03.2008, 06:01 Вопрос задал: Zet2007 (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Костя Симанович !!! Здравствуйте, Zet2007! Если я правильно понял задачу, то решение в приложении. Удачи. Эксперт невнимательно прочитал вопрос: надо найти среднее арифметическое непустого списка. Список - это динамическая структура данных. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 06.03.2008, 19:54 Приложение: program sarifm; function f(n : integer):real; var k, k1 : real; i : integer; begin k := 0; k1 := 0; for i := 1 to n do begin writeln('Введите ', i, ' Элемент'); readln(k); k1 := k1 + k; end; if k1 = 0 then begin writeln('Введены нулевые значения'); f := 0; end else f := k1/n; end; var n : integer; rez : real; begin writeln('Введите кол-во элементов списка'); readln(n); rez := f(n); writeln('Всего чисел= ', n, ' Среднее арифм. = ', rez:2:2); readln; end.

Ответ отправил: Костя Симанович (статус: 1-ый класс) Ответ отправлен: 06.03.2008, 08:13

Отвечает: Delph !!! Здравствуйте, Zet2007! Вот ещё вариант (в приложении). С использованием функции Random заполняется массив (в процессе заполнения отображается на экране), который и передаётся в функцию. Эксперт невнимательно прочитал вопрос: надо найти среднее арифметическое непустого списка. Список - это динамическая структура данных, а не массив. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 06.03.2008, 19:53 Приложение: Program Pr126186; Uses CRT; Const N = 24; Type TMyArray = Array[1..N] of Real; Function ArrMiddle(Massive: TMyArray): Real; var summ: Real; i: Integer; begin summ := 0; for i := 1 to N do summ := summ + Massive[i]; ArrMiddle := summ / N; end; Var Arr: TMyArray; i : Integer; Begin ClrScr; Randomize; WriteLn('Значения массива: '); for i := 1 to N do begin Arr[i] := Random * 20 - 10; { значения от -10 до +10 } Write(Arr[i]:9:4); if i mod 8 = 0 then WriteLn; end; WriteLn; WriteLn('Среднее арифметическое массива:', ArrMiddle(Arr):12:7); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 06.03.2008, 08:19

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Zet2007! Программа в приложении. Данный вопрос, кстати, уже обсуждался - 122626. Удачи! Приложение: type PElem = ^TElem; TElem = record value : integer; next : PElem; end; function summList(el:PElem):integer; var res : integer; begin res := 0; while el^.next <> nil do begin res := res + el^.value; el := el^.next; end; res := res + el^.value; summlist := res; end; procedure Add(var el : PElem; a : integer); var p : PElem; begin new(p); p^.next := el; p^.value := a; el := p; end; var el : PElem; a, count : integer; begin count := 0; repeat WriteLn('Input number (or "-1" to count):'); ReadLn(a); if a <> -1 then begin Add(el,a); count := count + 1; end; until a = -1; WriteLn('Summa: ', SummList(el)); WriteLn('Srednee: ',(SummList(el)/count):1:2);; ReadLn; end.

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

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