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

Выпуск № 419
от 07.07.2007, 15:05

Вопрос № 93.519

Здравствуйте. Помогите, пожалуйста, написать программу, которая при введении слова с дефисом меняла бы местами части слова до и после дефиса. Спасибо:).

Отправлен: 01.07.2007, 14:42 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! Посмотрите решение задачи в приложении: Приложение: uses CRT32; var st: string; p: integer; begin Writeln('Введите строку из 2-х слов разделенных дефисом'); Readln(st); p:=Pos('-',st); if p<>0 then begin st:=Copy(st,p+1,Length(st)-p)+'-'+Copy(st,1,p-1); Writeln(st); end else Writeln('Нет дефиса!'); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 15:30 Оценка за ответ: 5 Комментарий оценки: Заданная программа работает отлично. Спасибо!

Вопрос № 93.528

Здравствуйте. Помогите составить программу вычисления суммы: S=1+1*2+1*2*4+...+1*2*...*n Заранее спасибо.:))

Отправлен: 01.07.2007, 15:11 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Vassea Здравствуйте, Нижник Ксения Петровна! Если имеется в виду 1+1*2+1*2*3+1*2*3 +...+1*2*4*6*...*n то var i,n:integer; sum:longint; PR:longint begin readln(N); sum:=0; PR:=1; for i:=1 to n do begin sum:=sum+PR*i; PR:=PR*i end; writeln(Sum); end. Если необходима другая последовательность то необходимо правильно записать условие

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 19:43 Оценка за ответ: 4 Комментарий оценки: Нужна указанная последовательность 1+1*2+1*2*4+1*2*4*6+1*2*4*6*8+1*2*...*n - в каждом новом слагательном добавляется множитель на 2 больший предыдущего, парный. От программы требуется вычислить значение суммы после введения пользователем числа n(обязательно парного)- последнего множителя в окно ввода.

Отвечает: Gh0stik Здравствуйте, Нижник Ксения Петровна! Вот решение Вашей задачи: var i,n:integer; sum,v:longint; begin write('n=');read(n); v:=1; sum:=1; i:=2; while i <= n do begin v:=v*i; inc(sum,v); inc(i,2); end; writeln('sum=',sum); end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 03.07.2007, 23:51

Вопрос № 93.529

Здравствуйте. Помогите составить программу, которая спрашивает время суток и выводит на экран соответствуещее приветствие (доброе утро, добрый день, ночы, вечера). Заранее спасибо.:))

Отправлен: 01.07.2007, 15:14 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! Решение в приложении: Приложение: program z; uses Crt; var n: byte; begin ClrScr; Writeln('Kotoriy chas?'); Readln(n); case n of 0.. 5: Writeln('Dobroy nochi'); 6..11: Writeln('Dobroe utro'); 12..17: Writeln('Dobriy deni'); 18..23: Writeln('Dobriy vecher '); else Writeln('Vveli nepravilnoe vremya'); end; Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 00:59 Оценка за ответ: 4 Комментарий оценки: Программа хорошая, но если я ввожу, например, 11:25 - одиннадцать часов двадцать пять минут - то она не работает :(

Отвечает: Gh0stik Здравствуйте, Нижник Ксения Петровна! Если Вы сказали что Вы вводите время в формате hh:mm, то попробуйте еще такое решение: var s:string; h,code:integer; begin write('What time is it? ');read(s); val(copy(s,1,pos(':',s)-1),h,code); if code <> 0 then writeln('Error of time...') else case h of 0..4: writeln('good night'); 5..10: writeln('good moning'); 11..17: writeln('good day'); 18..23: writeln('good evening'); end; readln; end. Если Вы разбиваете сутки на другие интервалы, то Вам будет достаточно просто их изменить в операторе case. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 04.07.2007, 00:16

Вопрос № 93.530

Здравствуйте. Помогите составить программу упорядочивания значений трёх переменных таким образом, чтобы a)a<b<c b) a<b>c Заранее спасибо.:))

Отправлен: 01.07.2007, 15:16 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! Код в приложении. Процедура MinMax сортирует две переменные, в порядке возрастания. Приложение: program z; uses Crt; procedure MinMax(var min,max: integer); var t: integer; begin if min>max then begin t:=min; min:=max; max:=t; end; end; var a,b,c: integer; begin ClrScr; Writeln('Vvedite chisla a,b,c: '); Readln(a,b,c); MinMax(a,b); MinMax(b,c); Writeln(a,'<',b,'<',c); MinMax(c,b); Writeln(a,'<',b,'>',c); Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 19:47

Вопрос № 93.531

Здравствуйте. Помогите составить программу нахождения четвёртой точки паралелограмма по координатам известных 3 точек.Заранее спасибо.:))

Отправлен: 01.07.2007, 15:18 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! Решение действительно, только для случаев, когда вводятся три последовательные (!) координаты (A,B,C; B,C,D и т.д.). Допустим Вы ввели координаты A, B и C. Есть такие формулы, для нахождения середины отрезка: x=(x1+x2)/2 y=(y1+y2)/2 Благодаря им можно найти середину отрезка AC - это будет точка пересечения диагоналей: подставляем вместо x1 и y1 координаты точки A, вместо x2 и y2 координаты точки C. sx=(x1+x3)/2; sy=(y1+y3)/2; Теперь рассмотрим отрезок BD, где D - искомая точка: в нем известны точка B и середина отрезка, подставляем в наши формулы, вместо x1 и y1 координаты точки B, вместо x и y координаты середины отрезка, получим: x4=2*sx-x2; y4=2*sy-y2; Подставив вместо sx и sy ранее найденные уравнения, получим: x4=x1+x3-x2; y4=y1+y3-y2; Удачи. Приложение: program z; uses Crt; var x1,y1,x2,y2,x3,y3,x4,y4: integer; begin ClrScr; Write('Vvedite x1,y1: '); Readln(x1,y1); Write('Vvedite x2,y2: '); Readln(x2,y2); Write('Vvedite x3,y3: '); Readln(x3,y3); x4:=x1+x3-x2; y4:=y1+y3-y2; Writeln('x4 = ',x4); Writeln('y4 = ',y4); Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 00:48

Отвечает: Зенченко Константин Николаевич Здравствуйте, Нижник Ксения Петровна! Всего таких точек может быть три. В приложении программа которая их вычисляет. Удачи! Приложение: program q93531; var x,x1,x2,x3,y,y1,y2,y3:integer; begin write('enter x1,y1:'); readln(x1,y1); write('enter x2,y2:'); readln(x2,y2); write('enter x3,y3:'); readln(x3,y3); x:=x1-x2; y:=y1-y2; writeln('ABCD-x4:=',(x3+x):3,' y4:=',(y3+y):3); writeln('ABDC-x4:=',(x3-x):3,' y4:=',(y3-y):3); x:=x1-x3; y:=y1-y3; writeln('ADBC-x4:=',(x2+x):3,' y4:=',(y2+y):3); end. --------- И только наступив на грабли мы преобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Практикант) Ответ отправлен: 02.07.2007, 13:51

Вопрос № 93.532

Здравствуйте. Помогите составить для действительных значений a и b составить программу полного анализа и решения линейного уравнения ax=b и кубического уравнения ax^3+bx=0. Заранее спасибо.:))

Отправлен: 01.07.2007, 15:20 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Vassea Здравствуйте, Нижник Ксения Петровна! var a,b:real; x:real; begin readln(a,b); if (a=0) and (b=0) then begin writeln('любой x');readln; exit; end; if a=0 then begin writeln('нет таких x');readln; exit; end; writewln('x=',b/a); readln; end. var a,b:real; x:real; begin if (a=0) and (b=0) then begin writeln('любой x');readln; exit; end; if (a=0) or (b=0) then begin writeln('единственное решение x=0');readln; exit; end; if (-b/a <0) then begin writeln('единственное решение x=0, остальные комплексные');readln; exit; end; if -b/a >0 then begin writeln('x1=0'); writeln('x2=',sqrt(-b/a)); writeln('x3=',-sqrt(-b/a)); end; end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 19:53

Вопрос № 93.533

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

Отправлен: 01.07.2007, 15:22 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Vassea Здравствуйте, Нижник Ксения Петровна! var n:integer; st:string; begin readln(n); str(n,st); writeln(st[(n div 2)+1]); readln; end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 19:55 Оценка за ответ: 1 Комментарий оценки: Извините, но программа ВООБЩЕ не работает.

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! Мое решение, в котором не используются строки: Приложение: program z; uses Crt; var n,t: longint; i,k: integer; begin ClrScr; Readln(n); {Nahodim kolichestvo cifr v chisle} t:=n; k:=0; While t<>0 do begin t:=t div 10; k:=k+1; end; {Ishem srednuu cifru} t:=n; i:=0; While (i<>k div 2) do begin t:=t div 10; i:=i+1; end; Writeln(t mod 10); Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 00:12 Оценка за ответ: 4 Комментарий оценки: Неплохая программа, но если в числе более 10 цифр, то программа не выполняется:(

Вопрос № 93.534

Здравствуйте. Помогите составить программу сокращения одномерного массива путем удаления каждого второго элемента. Заранее спасибо.:))

Отправлен: 01.07.2007, 15:24 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! Привожу в приложении решение Вашего вопроса: Приложение: const n=11; var Mass: array[1..n] of Integer; Tmp: array[1..n div 2] of integer; i,j: integer; begin Randomize; Writeln('Дан одномерный массив из ',n,' чисел'); for i:=1 to n do begin Mass[i]:=10+Random(20); Writeln(i,' - ',Mass[i]:5); end; j:=0; for i:=1 to n do if i mod 2<>0 then begin j:=j+1; Tmp[j]:=Mass[i]; end; Writeln('Сокращенный массив'); for i:=1 to j do Writeln(Tmp[i]); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 21:10 Оценка за ответ: 4 Комментарий оценки: Юрий Михайлович, программа выдает сообщение при запуске: Ошибка:6 - выход за границы диапазона изменения индекса 1..5 (строка 20)

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! В отличии от предыдущего варианта решения, в моем не используется дополнительных массивов Приложение: program z; uses Crt; var i,j,k: integer; m: array[1..100] of integer; begin ClrScr; Write('Vvedite k: '); Readln(k); {Zapolnyaem massiv} Randomize; for i:=1 to k do begin m[i]:=Random(101)-50; Write(m[i]:4); end; Writeln; {Udalyaem elementi} for i:=k downto 2 do if i mod 2=0 then begin for j:=i to k-1 do m[j]:=m[j+1]; k:=k-1; end; {Vivodim noviy massiv} for i:=1 to k do begin Write(m[i]:4); end; Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 00:00 Оценка за ответ: 5

Вопрос № 93.535

Здравствуйте. Помогите составить программу поиска двух целых трёхзначных чисел, кратное которых наближает число Пи с наибольшей точностью. Заранее спасибо.:))

Отправлен: 01.07.2007, 15:25 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! Посмотрите решение в приложении, может понравится? Приложение: const n=15; var Mass: array[1..n] of Integer; i,j: integer; s: string; min1,min2: Real; c1,c2: integer; function Krat(n: integer): Real; var m: Real; begin m:=n; While m>Pi do m:=m/Pi; Result:=m; end; begin Randomize; Writeln('Дано ',n,' чисел'); for i:=1 to n do begin Mass[i]:=100+Random(99); Writeln(i,' - ',Mass[i]:5,' - ',Krat(Mass[i]):6:5); end; min1:=Pi; min2:=Pi; for i:=1 to n do begin if Krat(Mass[i])<min1 then begin min1:=Krat(Mass[i]); c1:=i; end; end; for i:=1 to n do begin if (Krat(Mass[i])<min2) and (c1<>i) then begin min2:=Krat(Mass[i]); c2:=i; end; end; Writeln('Наболее близки к Пи ',c1,' и ',c2,' числа'); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 20:29

Вопрос № 93.536

Здравствуйте. Помогите составить программу вывода на экран списка символов, из которых состоит введённый пользователем текст. Заранее спасибо.:))

Отправлен: 01.07.2007, 15:26 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Vassea Здравствуйте, Нижник Ксения Петровна! var st:string; ss:set of char; i:integer; c:char; begin readln(st); ss:=[]; for i:=1 to length(st) do if not (st[i] in ss) then begin writeln(st[i]); ss:=ss+[st[i]]; end; {ввод символов в порядке их появления по одному разу} { если необходимо вывести в алфавитном порядке то} for c:=chr(0) to chr(255) do if c in ss then writeln(C); readln; end. Исправлена ошибка 'Types mismatch'. [Denisss]

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 20:03 Оценка за ответ: 2 Комментарий оценки: В программе выдаётся ошибка: операнды имеют неприводимые типы:(

Отвечает: Louken Здравствуйте, Нижник Ксения Петровна! Код программы в приложении: Приложение: program z; uses Crt; var s: string; mn: set of char; i: integer; ch: char; begin ClrScr; Writeln('Vvedite stroku'); Readln(s); {V nachale mnojestvo pusto} mn:=[]; {Zapolnyaem mnojestvo} for i:=1 to length(s) do Include(mn, s[i]); {Vivodim mnojestvo} for ch:=#0 to #255 do if ch in mn then Write(ch:2); Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 02.07.2007, 19:18

Вопрос № 93.537

Здравствуйте. Помогите составить программу которая бы упорядочивала введённые слова по алфавиту. Заранее спасибо.:))

Отправлен: 01.07.2007, 15:27 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! В приложении решение Вашей задачи Приложение: const n=10; var Mass: array[1..n] of string; i,j: integer; s: string; begin Writeln('Введите последовательно ',n,' слов'); for i:=1 to n do begin Write('Слово ',i,' - '); Readln(Mass[i]); end; for i:=1 to n do for j:=n downto 1 do begin if Mass[j]<Mass[i] then begin s:=Mass[i]; Mass[i]:=Mass[j]; Mass[j]:=s; end; end; for i:=1 to n do Writeln(mass[i]); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 19:50 Оценка за ответ: 4 Комментарий оценки: Все слова упорядочились правильно, но только слово ананас почему-то стояло в самом конце. А если я хочу ввести 5 слов и 13 - мне что, каждый раз вносить изменения в прогу?

Вопрос № 93.538

Здравствуйте. Помогите составить программу вычисления 100!(факториал). Заранее спасибо.:))

Отправлен: 01.07.2007, 15:28 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Coupler Здравствуйте, Нижник Ксения Петровна! Так как 100! очень большое число, то его нужно хранить в одномерном динамическом массиве. Решение задачи в приложении. Приложение: program fact; {$APPTYPE CONSOLE} uses SysUtils; var M: array of integer; F, i, j, k, n: integer; begin writeln('Vvedite n'); readln(n); if n < 4 then exit; setLength(M, 2); //определение границ массива M[0] := 1; //присвоение 0-ому элементу массива М значения 1.... M[1] := 0; k := 1; for i := 1 to n do begin F := 0; for j := 0 to k do begin SetLength(M, k + 1); M[j] := M[j] * i + F; //здесь основная идея программы if (M[j] div 10) > 0 then k := k + 1; F := M[j] div 10; M[j] := M[j] mod 10; end; end; for i := k downto 0 do //перебор целых значений от k до 0 begin if M[i] > 0 then break; if M[i] = 0 then k := k - 1; end; SetLength(M, k); //изменение размеров массива М до кол-ва элементов-k for j := k downto 0 do write(M[j]); M := nil; readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 01.07.2007, 16:31

Отвечает: _killhunter_ Здравствуйте, Нижник Ксения Петровна! Для вычисления факториала лучше использовать рекурсивную функцию, котора использует тождество С(n,k) = C(n-1,k-1)+C(n-1,k) В приложении пример такой ф-ии Приложение: Function Fact(n,k : integer):integer begin if (k=1) or (k=n-1) then Fact := n else Fact := Fact(n-1,k-1)+Fact(n-1,k) end;

Ответ отправил: _killhunter_ (статус: 1-ый класс) Ответ отправлен: 02.07.2007, 12:37 Оценка за ответ: 4 Комментарий оценки: З пример функции спасибо, но мне нужна вся программа.

Вопрос № 93.539

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

Отправлен: 01.07.2007, 15:30 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Vassea Здравствуйте, Нижник Ксения Петровна! type arr=array [1..10] of integer; {ряд} a=array [1..10] of arr; var M:a; x,y:integer; i,j:integer; c:a; begin readln(x,y); {x- кол-во рядов, y-кол-во столбцов} for i:=1 to x do for j:=1 to y do readln(M[i,j]); {ввод массива} c:=M[3]; M[3]:=M[1]; M[1]:=c; {замена рядов} readln; end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 18:41

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! Попробуйте метод, приведенный в приложении: Приложение: const n=10; var Mass: array[1..n,1..n] of integer; i,j,m: integer; begin Randomize; Write('Исходный массив'); for i:=1 to n do begin for j:=1 to n do begin Mass[i,j]:=10-Random(20); Write(Mass[i,j]:3); end; Writeln; end; Write('Меняем местами 1 и 3 ряды'); for i:=1 to n do begin m:=Mass[i,1]; Mass[i,1]:=Mass[i,3]; Mass[i,3]:=m; end; for i:=1 to n do begin for j:=1 to n do begin Write(Mass[i,j]:3); end; Writeln; end; Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 19:39 Оценка за ответ: 5 Комментарий оценки: Спасибо, прога хорошая, работает

Отвечает: _killhunter_ Здравствуйте, Нижник Ксения Петровна! Если необходимо поменять местами значения то это делается следующей процедурой Приложение: Procedure Exch(var A:MyArray;n:integer)// где MyArray - тип исходного массива, n-число строк в массиве, нумерация массива начинается с 1 var i : integer; x : MyType;//MyType - тип данных массива begin for i := 1 to n do begin x := A[i,1]; A[i,1]:=A[i,3]; A[i,3]:=x; end; end;

Ответ отправил: _killhunter_ (статус: 1-ый класс) Ответ отправлен: 02.07.2007, 13:01 Оценка за ответ: 2 Комментарий оценки: А что это в приложении - программа?

Вопрос № 93.540

Здравствуйте. Помогите составить программу, которая бы определяла, будет ли выпуклым n-угольник, заданный на плоскости координатами его последовательных вершин . Заранее спасибо.:))

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

Отвечает: _killhunter_ Здравствуйте, Нижник Ксения Петровна! Для ответа на этот вопрос достаточно сравнить знаки векторных произведений векторов [(A1,A2),(A1,A3)], [(A1,A3),(A1,A4)],...,[(A1,An-1),(A1,An)]. Если знаки всех произведений совпадут, тогда многоугольник выпуклый. В приложении напишу код Функции выщитывающей векторное произведение векторов (А1,А2) и (А1,А3) (точка Аn задается двумя координатами X,Y) Приложение: Function Vect(x1,y1,x2,y2,x3,y3 : double) : double var x12, y12, x13, y13 : double begin x12 := x1-x2; y12 := y1-y2; x13 := x1-x3; y13 := y1-y3; vect := x12*y13 - x13*y12 end;

Ответ отправил: _killhunter_ (статус: 1-ый класс) Ответ отправлен: 02.07.2007, 12:22

Вопрос № 93.556

Дана действительная квадратная матрица порядка n. Вычислить сумму тех ее элементов, расположенных на главной диагонали и выше нее, которые превосходят по величине все элементы, расположенные ниже главной диагонали. Если на главной диагонали и выше нее нет элементов с указанным свойством, то ответом должно служить сообщение об этом. Предложение содержит буквы латинского и русского алфавитов. Написать программу, которая выводит буквы только латинского алфавита в порядке их следования в предложении. Приложение: Пожалуйста решите послезавтра экзамен!!!!!

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

Отвечает: Vassea Здравствуйте, ZET! var max:integer; M:array [1..10,1..10] of integer; sum:integer; i,j:integer; n:integer; begin readln(n); for i:=1 to n do for j:=1 to n do readln(M[i,j]); for i:=2 to n do for j:=1 to i-1 do if (i=2) or (M[i,j]>max) then max:=M[i,j]; {поиск максимального элемента ниже диагонали} sum:=0; for i:=1 to n do for j:=i to n do if M[i,j]>max then Sum:=Sum+M[i,j]; writeln(Sum); readln; end. var st:string; ss:set of char; i:integer; begin readln(st); ss:=['a'..'z','A'..'Z']; for i:=1 to length(st) do if st[i] in ss then write(st[i]); end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 01.07.2007, 19:36 Оценка за ответ: 3 Комментарий оценки: все задачи полностью нерешены!

Отвечает: Louken Здравствуйте, ZET! В приложении решение Ваших задач: Приложение: program z1; uses Crt; var i,j,sum,max,n: integer; m: array[1..10,1..10] of integer; b: boolean; begin ClrScr; {Vvodim razmer matrici} Write('Vvedite n: '); Readln(n); {Vvodim matricu} for i:=1 to n do for j:=1 to n do begin Write('m[',i,',',j,'] = '); Readln(m[i,j]); end; {Vivodim matricu v privichnom vide} ClrScr; for i:=1 to n do begin for j:=1 to n do Write(m[i,j]:4); Writeln; end; {Nahodim max element matrici} max:=m[2,1]; for i:=2 to n do for j:=1 to i-1 do if m[i,j]>max then max:=m[i,j]; {Nahodim summu} b:=false; sum:=0; for i:=1 to n do for j:=i to n do begin if m[i,j]>max then begin sum:=sum+m[i,j]; b:=true; end; end; {Vivodim otvet} if b then Writeln('Summa = ',sum) else Writeln('Summu ne udalosi nayti'); Readln; end. ========================================== program z2; uses Crt; const EnglishChar: set of char = ['A'..'Z','a'..'z']; var i: integer; s,s1: string; begin ClrScr; Writeln('Vvedite stroku:'); Readln(s); s1:=''; for i:=1 to Length(s) do if s[i] in EnglishChar then s1:=s1+s[i]; Writeln(s1); Readln; end.

Ответ отправил: Louken (статус: 9-ый класс) Ответ отправлен: 01.07.2007, 23:35 Оценка за ответ: 5

Вопрос № 93.573

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

Отправлен: 01.07.2007, 21:19 Вопрос задала: Нижник Ксения Петровна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Градов Юрий Михайлович Здравствуйте, Нижник Ксения Петровна! Надеюсь, что форма не проглотит знаки. У себя я проверяю решение - все Ок! Приложение: const n=12; var Mass: array[1..n] of Integer; i,j: integer; s: string; min: Real; c1,c2: integer; function Chastn(n,m: integer): Real; begin if n>m then Result:=n/m else Result:=m/n; end; begin Randomize; Writeln('Дано ',n,' чисел'); for i:=1 to n do begin Mass[i]:=100+Random(99); Writeln(i,' - ',Mass[i]:5); end; min:=999; for i:=1 to n do begin for j:=n downto 1 do begin if Abs(Pi-Chastn(Mass[i],Mass[j]))<min then begin min:=Abs(Pi-Chastn(Mass[i],Mass[j])); c1:=i; c2:=j; end; end; end; Writeln('Частное чисел № ',c1,' и № ',c2,' наиболее близко к Пи'); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 01.07.2007, 22:14 Оценка за ответ: 3 Комментарий оценки: К сожалению, программа выдаёт числа, частное которых = 1.7. Пи = 3.14. Возможно, неясно поставлена задача - нужно чтобы при делении первого чтсла на второе получалось 3.14, 3.13, 3.15 или что-то около того.

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Нижник Ксения Петровна! Большее число начинается от 300 потому, что минимальное меньшее = 100. И даже при нем приближение в 3 = 300 / 100, очевидно, не лучшее (314/100 гораздо точнее) Соответственно, наибольшее значение меньшего числа равно 350 потому, что 999, будучи деленным даже на 350, уже дает меньше 3-х. Соответственно для любых j больше 350, приближение будет еще хуже. Код в приложении. Я когда-то делал эту задачу, числа в ответе должны получиться около 355 и 117. Воообще, можно написать гораздо более быстро работающий код, но в условии ничего про скорость не сказано, да и этот код на всех современных копмьютерах выполняется достаточно быстро. Не люблю транслит, поэтому написал на англ. Фраза буквально переводится как "наилучшее приближение ПИ отношением 3-хзначных чисел является". UPD Исправлено double на extended Приложение: var numerator, denominator: integer; i, j: integer; pi_approx: extended; err: extended; const pi: extended = 3.141592653589793238; BEGIN err := 10.0; for i := 300 to 999 do begin for j := 100 to 350 do begin pi_approx := i / j; if (abs(pi - pi_approx) < err) then begin err := abs(pi - pi_approx); numerator := i; denominator := j; end; end; end; writeln('Best approximation of PI by rate of 3-digit numbers is ', numerator, '/', demoninator); END. --------- Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Специалист) Ответ отправлен: 02.07.2007, 14:14

Вопрос № 93.590

1.В файле f записан массив действительных чисел. Найти наименьшее из этих чисел 2.Четыре точки заданы своими координатами X(x1, x2, x3), Y(y1, y2, y3), Z(z1, z2, z3), T(t1, t2, t3).Выяснить, какие из них находятся на минимальном расстоянии друг от друга и вывести на печать значение этого расстояния. Вычисление расстояния между двумя точками оформить в виде процедуры. 3.После каждого движения поршня разряжающего насоса их сосуда удаляется 20% находящегося газа. Сколько движений поршня нужно сделать, чтобы достичь давления P при начальном давлении Pn. Приложение: Вторую задачу решите очень подробно и обьясните коменнтариями !

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

Отвечает: Coupler Здравствуйте, ZET! Насчет второй задачи: Вы уже задавали вопрос 90051, поэтому я здесь немного его разберу. По первой задаче - отрицательные и неверные значения получаются из-за переполнения. Возьмите другой тип данных, или используйте длинную арифметику - но это уже будет совсем другая задача, гораздо более сложная, если писать ее сначала. Вторая задача - нет там "error in statement" и быть не может. Этот код свободно компилируется как BP 7.0, так и delphi. Выкладываю в приложение тот же код, только откоментированный. Если преподаватель информатики спросит Вас то, чего нет в комментариях - пользуйтесь внутренней почтой - я Вам отвечу, не надо задавать вопрос несколько раз. Приложение: program Project1; type TPoint = record x, y, z: integer; end; function len(x1, x2: TPoint): real; {функция вычисления длины} begin len := sqrt(sqr(x2.x - x1.x) + sqr(x2.y - x1.y) + sqr(x2.z - x1.z)); {школьная формула} end; var points: array[1..4] of TPoint; l, min: real; {длины - текущая и мин.} s: string[4]; i, j: integer; {номера точек в массиве s} im, jm: integer; {номера точек с мин. расстоянием в массиве s} f: integer; begin s := 'XYZT'; {имена точек} for i := 1 to 4 do begin writeln('Vvedite koordinati tochki ', s[i]); readln(points[i].x, points[i].y, points[i].z); {считываем координаты точек} end; f := 0; {минимальное расстояние не получено} for i := 1 to 4 do {всего 6 расстояний} for j := i + 1 to 4 do {xy,xz,xt,yz,yt,zt}3 begin l := len(points[i], points[j]); if (f = 0) then begin min := l; im := i; jm := j; f := 1; {минимальное расстояние получено} end else if (l < min) then begin min := l; {запоминаем расстояние и} im := i; {точку} jm := j; end end; writeln('Min rasstoyanie = ', min, ' mezhdu ', s[im], ' i ', s[jm]); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 02.07.2007, 08:58

Отвечает: Vassea Здравствуйте, ZET! 1) Скорее всего файл текстовый и числа записаны через пробел в одну строку. тогда var min:real; M:array [1..200] of real i,n:integer; f:text; begin assign(f,'text.txt'); reset(F); n:=0; while not eof(f) do begin n:=n+1; { в n после завершения цикла будет храниться количество чисел} read(f,M[n]); end; close(f); min:=M[1]; {Сначала считаем что минимальный элемент -- первый} for i:=2 to n do if M[i]< min then min:=M[i]; {сравниваем все оставшиеся элементы с min} writeln(Min); readln; end. Делать это в виде процедуры можно но не удобно var M:array [1..4] of record x,y,z:real; {здесь будут храниться координаты точек} end; RR:real;{расстояние} min, {здесь будет храниться ответ} tek {здесь будет храниться расстояние между текущими точками} :real; i,j:integer; procedure АА(x,y,z:real; {координаты I точки} x1,y1,z1:real; {координаты II точки} var Res:real); {var перед Res необходим так как через эту переменную будет возвращаться результат} begin Res:=sqrt( sqr(x1-x) + sqr(y1-y) + sqr(z1-z) ); {известная формула для нахождения расстояния} end; begin for i:=1 to 4 do begin writeln('Введите координаты точки ', i); readln(M[i].x,M[i].y,M[i].z); {Вводим координаты для i-той точки} end; min:=-1; { приравниваем к -1 так как такого расстояния быть не может и если расстояние равняется -1 значит не будет сравнивать текущее расстояние с мин а сразу будем присваивать } for i:=1 to 3 do for j:=i+1 to 4 do {цикл для создания всех комбинации i=1 j=2,3,4 i=2 j=3,4 i=3 j=4 } begin if min=-1 then AA(M[i].x,M[i].y,M[i].z,M[j].x,M[j].y,M[j].z, Min ) else begin AA(M[i].x,M[i].y,M[i].z,M[j].x,M[j].y,M[j].z, tek ); if tek<min then min:=tek; {если текущее значение меньше мин то мин:=tek} end; end; writeln(min); readln; end. var P, PN:real; n:integer; begin readln(P,PN); n:=0; while P>Pn do begin P:=P*0.8; n:=n+1; end; writeln(n); readln; end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 02.07.2007, 09:17

Вопрос № 93.599

Дан двумерный массив вещественных чисел из 4 столбцов и 3 строк. Найти сумму максимальных элементов каждой строки. Вывести массив по строкам. После каждого движения поршня разряжающего насоса их сосуда удаляется 20% находящегося газа. Сколько движений поршня нужно сделать, чтобы достичь давления P при начальном давлении Pn. Приложение: I need HELP!!!

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

Отвечает: Omickron Здравствуйте, ZET! Дан двумерный массив вещественных чисел из 4 столбцов и 3 строк. Найти сумму максимальных элементов каждой строки. Вывести массив по строкам. Я точно не помню уже как выводятся числа в консольке... За это извиняйте... А в остальном - пожалуйте. Приложение: var mas:array [1..4][1..3] of real; z,max:real; //максимальное в строке и сумма маскимальных чисел i,j:integer; //счётчики procedure proc; begin max:=0; for i:=1 to 3 do begin z:=mas[1][i]; white (z); write (' '); for j:=2 to 3 do if mas[j][i]>z then z:=mas[j][i]; //вычисление максимального в строке white (mas[j][i]); write (' '); Inc(max,z); writeln; end; end;

Ответ отправил: Omickron (статус: 3-ий класс) Ответ отправлен: 02.07.2007, 08:05

Отвечает: Andreev Oleg Здравствуйте, ZET! После каждого движения поршня разряжающего насоса их сосуда удаляется 20% находящегося газа. Сколько движений поршня нужно сделать, чтобы достичь давления P при начальном давлении Pn. program two; var Pn,p:real;i:integer; begin writeln('Vvedite Pn');readln(pn); writeln('Vvedite P');readln(p); i:=0;(*счетчик движений*) while (Pn>P) do begin Pn:=Pn*0.8;(*уменьшаем давление*) i:=i+1;(*увеличиваем число движений*) end; if i=0 then writeln('Oshibka, Pn >= P') else writeln('Chslo dvizheniy ',i) end.

Ответ отправил: Andreev Oleg (статус: 4-ый класс) Ответ отправлен: 02.07.2007, 09:10 Оценка за ответ: 5

Отвечает: Vassea Здравствуйте, ZET! var ARR:array[1..3,1..4] of real; sum:real; max:real; i,j:integer; begin for i:=1 to 3 do for j:=1 to 4 do readln(Arr[i,j]); { ввод массива} sum:=0; {начальное значение суммы} for i:=1 to 3 do {для каждой строки} begin for j:=1 to 4 do {поиск ее максимального значения} begin if j=1 then max:=Arr[i,j] {если первый элемент то max } else begin if ARR[i,j]>max then max:=ARR[i,j]; end; end; sum:=sum+max; end; writeln(Sum); readln; for i:=1 to 3 do begin for j:=1 to 4 do write(Arr[i,j],' '); writeln; end; readln; end. var P, PN:real; n:integer; begin readln(PN,P); {в первом варианте перепутал начальное и конечное давление} n:=0; while PN>P do begin PN:=PN*0.8; n:=n+1; end; writeln(n); readln; end.

Ответ отправил: Vassea (статус: 4-ый класс) Ответ отправлен: 02.07.2007, 09:26

Вопрос № 93.625

Создать программу, имитирующую работу с базой данных по предложенной предметной области на основе типизированного файла. Функциями программы (выбираются из стартового меню) являются: 1. Создание нового файла базы данных 2. Открытие существующего файла базы данных 3. Добавление данных в файл базы данных 4. Просмотр всех данных, хранящихся в файле базы данных, в виде списка 5. Просмотр данных, удовлетворяющих определенным условиям отбора, отсортированных по указанному критерию вот и программа Склад. Составить программу формирования данных о товарах на складе: номер по порядку, наименование товара, цена, количество единиц товара. Организовать выбор товаров по диапазону цен и упорядочить его по наименованиям. Приложение: ПОЯСНЯЙТЕ КОММЕНТАРИЯМИ !!!!РЕШИТЕ ПОЖАЛУЙСТА!!!!!!

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

Отвечает: Coupler Здравствуйте, ZET! Решение задачи в приложении. Я не делал никаких проверок на существование файла, оставив это Вам, если это требуется. Если будут вопросы - пишите во вн. почту. Приложение: program Project1; uses crt; type TItem = record {запись} num: word; naim: string[30]; price: word; kol: word; end; type TDataFile = file of TItem; {типизированный файл} var f: TDataFile; name: string; choice: byte; procedure readdata; {чтение данных} var item: TItem; begin reset(f); while not (eof(f)) do begin read(f, item); with item do writeln(num, ' ', naim, ' ', price, ' ', kol); end; close(f); readln; end; procedure appenddata; {добавление в файл} var temp: TDataFile; item: TItem; begin assign(temp, 'temp.dat'); rewrite(temp); reset(f); while not (eof(f)) do begin read(f, item); write(temp, item); end; writeln('Vvedite num'); readln(item.num); writeln('Vvedite naim'); readln(item.naim); writeln('Vvedite price'); readln(item.price); writeln('Vvedite kol'); readln(item.kol); write(temp, item); close(f); close(temp); erase(f); rename(temp, name); end; procedure create; {создание файла} begin writeln('Enter filename'); readln(name); assign(f, name); rewrite(f); close(f); end; procedure open; {открытие файла} begin writeln('Enter filename'); readln(name); assign(f, name); end; procedure processing; {обработка по запросу} var temp: array [1..200] of TItem; item: TItem; i, n, k: word; pricebegin, priceend: word; begin writeln('Vvedite nachalhuyu tsenu'); readln(pricebegin); writeln('Vvedite konechnuyu tsenu'); readln(priceend); n := 1; {заносим в массив temp подходящие по запросу элементы} reset(f); while not (eof(f)) do begin read(f, item); if (item.price > pricebegin) and (item.price < priceend) then begin temp[n] := item; inc(n); end; end; close(f); dec (n); if n > 0 then begin for k := 1 to n do {сортировка} for i := 1 to n - k do begin if temp[i].naim > temp[i + 1].naim then begin item := temp[i]; temp[i] := temp[i + 1]; temp[i + 1] := item; end; end; for i := 1 to n do {вывод на экран} with temp[i] do writeln(num, ' ', naim, ' ', price, ' ', kol); end else writeln('Takih dannih net'); readln; end; begin repeat clrscr; writeln('1 - Create'); writeln('2 - Open'); writeln('3 - Add'); writeln('4 - List'); writeln('5 - Processing'); writeln('6 - Exit'); readln(choice); case choice of 1: create; 2: open; 3: appenddata; 4: readdata; 5: processing; 6: ; else writeln('Nevernii nomer'); end; until choice = 6 end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 02.07.2007, 18:04

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