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

Выпуск № 376
от 21.05.2007, 19:35

Вопрос № 87.055

Как пишется программа для преобразования целых и дробных чисел из десятеричной в шестнадцатеричную?

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

Отвечает: Verena Здравствуйте, Evglena! Для перевода целой части десятичного числа в шестнадцатеричное, необходимо брать остатки от деления этого числа на 16 в обратном порядке. Перевод дробной части, напротив, производится умножением на 16 (в ответ берутся целые части, а умножение продолжается только для дробной). Можете почитать об этом вот здесь: http://www.distant-school.ru/modules.php?name=Articles&pa=showarticle&articles_id=146 А код - в приложении. Удачи! Приложение: var h, r, eps, i: integer; x, p: real; otv, rev: string; begin readln (x); h:= trunc(x); p:= x-h; repeat r:= h mod 16; {сохраняем остаток} h:= h div 16; {оставляем только целую часть} if r<10 then otv:= otv + chr (r+48) {код цифры в ascii таблице равен самой цифре +48} else otv:= otv+chr (r+55); {шаг до буквы А от 10 = 55} until h<=0; for i:=1 to length(otv) do rev:= rev+otv[length(otv)-i+1]; {записываем остатки задом наперёд} otv:= rev; eps:=0; {точность дробной части} otv:= otv+'.'; repeat r:= trunc (p*16); {берём целую часть} p:= p*16-r; {оставляем только дробную} if r<10 then otv:= otv+chr (r+48) else otv:= otv+chr (r+55); inc (eps); until (p=0) or (eps>10); writeln (otv); end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 15.05.2007, 21:17 Оценка за ответ: 5 Комментарий оценки: Спасибо большое, программа работает.

Вопрос № 87.065

Люди добрые! Пожалуйста, помогите с курсовиком! Естественно я не жду целого курсовика, мне нужны только советы и помощь в написании процедур. Вся сложность для меня заключается в том, что курсач делается через динамику. Спасибо всем заранее. Приложение: СТАТИСТИКА ИЗМЕРЕНИЙ Программный модуль «Статистика» собирает простейшую статистику использования вещественных чисел (до 100). Модуль содержит следующие функции и процедуры: - Запомнить значение (введенное значение запоминается в буфере статистики, если содержимое счетчика значений не превышает 100, и если ввод числа был правильным); - Число значений (возвращает число ранее введенных значений, содержащихся в буфере статистики); - Максимальное значение (возвращает максимальное из ранее введенных чисел); - Минимальное значение (возвращает минимальное из ранее введенных чисел); - Очистить все (очищает буфер ввода статистики); - Удалить значение (удаляет значение из буфера); - Среднее значение (возвращает среднее из ранее введенных чисел); - Квадратичное отклонение (вычисляет среднеквадратичное отклонение от среднего для ранее введенных значений); - Записать буфер в файл (записывает содержимое буфера в типизованный файл); - Построить график (сплошной линией строится график среднего значения в зависимости от числа значений, точками – истинные значения чисел в буфере статистики). В качестве примера практического использования модуля рассмотрите задачу о статистике измерений диаметра 30 контрольных деталей из партии. Пользователю программа предлагает меню для выбора перечисленных процедур. Сообщения об ошибках: - «Буфер переполнен», если счетчик значений превышает 100; - «Слишком мало значений», если в буфере менее 5 значений; - «Неправильный ввод», если сделана ошибка при выборе пункта меню.

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

Отвечает: Verena Здравствуйте, Ведерников Кирилл Игоревич! Напишу о динамической памяти. Для работы с ней в Паскале есть функции выделения и освобождения, например, getmem (переменная, размер) в паре с freemem (переменная, размер) или new (переменная) в паре с dispose (переменная). Вы не указали, в каком виде должны храниться данные статистики в программе. Тут два наиболее подходящих пути: динамический массив и динамический список. Для примера я написала Вам реализацию добвления нового элемента в динамический массив и добавдения элемента, освобождения и нахождения максимального для динамического списка. С динамическим массивом вся работа происходит также, как с обычным, только обращение к элементу будет не просто a[i], а a^[i]. Дополнительное действие - только однократное (обычно) выделение памяти и освобождение памяти, как првило, в конце программы. Так что написать какие-либо функции с использование такого массива Вам не должно быть сложным. Реализацию динамического массива смотрите в приложении, пример 1 (процедуру написала из расчёта, что массив и размерность буфера будут глобальными переменными (доступными во всей программе, не переопределёнными в процедурах), а вообще можете добавить их параметры, если использовать глобальные переменные не будете). Список - динамическая структура данных, где каждый элемент содержит ссылку на следующий (однонаправленный линейный список), а последний содержит ссылку на nil. Каждый элемент списка - запись, состоящая из минимум двух полей - информации и ссылки. Пример реализации списка в приложении, пример 2. Подробней о списках можете почитать тут: http://declic.narod.ru/ossio/files/book/part_7_2.html О динамической памяти вообще и о работе с динамическими массивами можете почитать тут: http://declic.narod.ru/ossio/files/book/part_7_1.html#head По обоим ссылкам содержатся и теория, и примеры. Удачи! Приложение: ПРИМЕР 1 type stat: array [1..1] of real; {описываем массив размерностью 1} var a: ^stat; {описываем а как динамический массив} n: integer; {количество введённых данных} procedure Add (x: real); {добавление нового числа} var i: integer; t: ^stat; begin getmem (t, sizeof (real)*(n+1)); {выделяем память для существующих объектов и ещё одного} for i:=1 to n do t^[i]:= a^[i]; {переписываем во временный массив имеющиеся значения} t[n+1]:= x; {последнему присваиваем новое значение} freemem (a, sizeof (real)*n); {очищаем память из-под массива а (также будет осуществляться "очистка буфера" из Вашего задания)} getmem (a, sizeof (real)*(n+1)); {выделяем память под а, но уже под n+1 элемент} inc (n); {наращиваем счётчик элементов} for i:=1 to n do {переписывам из временного массива все элементы в а} a^[i]:= t^[i]; freemem (t, sizeof (real)*n); {освобюождаем память из-под временного массива} end; ПРИМЕР 2 Type stat = ^s; {описываем динамический список записей типа s} s = record i: real; next: stat; End; Var first, q: stat; {храним указатель на первый элемент списка в переменной first} n: integer; Procedure Add (var first: stat; var n: integer; z: real); {добавление нового элемента в конец списка} Var x, q: stat; {новый элемент x} Begin New (x); {выделяем память под новый элемент} x^.i:= z; {присваиваем новое значение} q:= first; {ставим указатель на first} while q^.next<>nil do q:= q^.next; {пробегаем до конца списка, т.е. пока ссылка next не станет равна nil} q^.next:= x; {приклеиваем новый элемент} x^.next:= nil; {ссылка next ставится nil, поскольку новый элемент - последний в списке} inc (n); {наращиваем счётчик элементов} End; Procedure Del (var first: stat); {очистка списка (буфера)} var q: stat; begin while first<>nil do {пока первый элемент не будет указывать на nil} begin q:= first; {запоминаем первый элемент} first:= first^.next; {считаем первым элементом второй} dispose (q); {освобождаем память из-под бывшего первого элемента, ссылка на который сохранилась в q} end; end; Function Max (first: stat): real; {функция нахождения максимума} var q: stat; m: real; begin q:= first; {начинаем с первого элемента} m:= q^.i; {берём первый элемент за максимум} while q<>nil do {пока текущий элемент не nil} begin if q^.i>m then m:= q^.i; q:= q^.next; {переходим на следующий элемент по ссылке next} end; end; --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 15.05.2007, 22:31

Вопрос № 87.098

Даны три точки на плоскости: A B C, которые образуют треугольник, и точка D... определить где находится эта точка D (внутритреугольника, на границе или вне треугольника)?

Отправлен: 16.05.2007, 00:54 Вопрос задал: Антон Ульянов (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Устинов С.Е. Здравствуйте, Антон Ульянов! Решение задачи в приложении, здесь попробую объяснить теорию. Точка D лежит между A и B (на одном отрезке) если AD+DB=AB. Проверив не лежит ли точка одном из отрезков можно говорить о том лежит она на границе или нет. Теперь насчет вхождения внутрь треугольника. Так как сначала обработаем вариант, что точка лежит на границе, то остается только варианты "вне треугольника" или "внутри треугольника". Предлагаю проверить на "вхождение в треугольник" таким образом (другого просто что-то в голову не приходит): Если сумма площадей треугольников ABD+ACD+BCD равна площади треугольника ABC, то точка D лежит внутри треугольника ABC. (постройте рисунок и Вы увидите, почему так). Теперь насчет функций: функция Ras(T1,T2:dot):real; возвращает длину отрезка между точками T1 и T2 (параметрами функции). Функция S(T1,T2,T3:dot):real; возвращает площадь треугольника с вершинами T1, T2, T3. Ну а теперь самое "странное". Я верху объяснял про проверку принадлежности точки отрезку, и вроде-бы логично было бы проверять так (с учетом введенных функций): если (Ras(A,D)+Ras(D,B))=Ras(A,B) то D лежит на одном отрезке с A и B между ними (т.е. принадлежит границе). Но в Паскале точность переменной real составляет 11-12 знаков. И поэтому сумма двух отрезков не всегда получится равной третьему, даже если эти три точки лежат "так как надо". Для этого я ввел понятие константу "точность", и проверяю не (Ras(A,D)+Ras(D,B))=Ras(A,B) (что равносильно (Ras(A,D)+Ras(D,B)-Ras(A,B)=0) а Ras(A,D)+Ras(D,B)-Ras(A,B) < toch - т.е. меньше какой-то погрешности. Аналогичная ситуация с подсчетом сумм площадей. Будут вопросы - обращайтесь. Удачи! Приложение: const toch=0.000000001; type dot=record x,y:real; end; var A,B,C,D:dot; stat:string; function Ras(T1,T2:dot):real; begin Ras:=sqrt(sqr(T2.x-T1.x)+sqr(T2.y-T1.y)); end; function S(T1,T2,T3:dot):real; var a,b,c,p:real; begin a:=Ras(T1,T2); b:=Ras(T1,T3); c:=Ras(T2,T3); p:=(a+b+c)/2; S:=sqrt(p*(p-a)*(p-b)*(p-c)); end; begin write('Vvedite koordinaty A(x,y)='); readln(A.x,A.y); write('Vvedite koordinaty B(x,y)='); readln(B.x,B.y); write('Vvedite koordinaty C(x,y)='); readln(C.x,C.y); write('Vvedite koordinaty D(x,y)='); readln(D.x,D.y); stat:='Vne treugolnika'; if (Ras(A,D)+Ras(D,B)-Ras(A,B) < toch) or (Ras(C,D)+Ras(D,B)-Ras(C,B) < toch) or (Ras(C,D)+Ras(D,A)-Ras(C,A) < toch) then stat:='Na granice' else if abs(S(A,B,C)-(S(A,B,D)+S(A,C,D)+S(C,B,D))) < toch then stat:='Vnutri treugolnika'; writeln('Otvet: ',stat); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Практикант) Ответ отправлен: 16.05.2007, 02:11

Отвечает: Gh0stik Здравствуйте, Антон Ульянов! Я предлагаю рассматривать такое произведение: f(A,B,D)*f(A,C,D)*f(C,B,D), где соответственно f(Q,W,E) - значение функции, которая построена на точках Q,W, в точке E. Путем несложных вычислений можно заметить что f(A,B,D)*f(A,C,D)*f(C,B,D) < 0 - тогда и только тогда когда точка D лежит внутри треугольника ABC. Если f(A,B,D)*f(A,C,D)*f(C,B,D) > 0 - это говорит о том что точка лежит вне треугольника. Остается рассмотреть только при f(A,B,D)*f(A,C,D)*f(C,B,D) = 0, это может быть достигнуто только тогда когда точка D лежит на одной из прямой на которых построен треугольник. Остается определить лежит ли данная точка на границе треугольника, решение этой проблемы я позаимствовал у эксперта Устинова С.Е. (находил сумму площадей соответствующих составляющих треугольников и если она была равна площади всего треугольника, следовательно точка лежит на границе), но использовал формулу, которую предложил в мини-форуме эксперт Сухомлин Кирилл Владимирович. Good Luck!!! Приложение: type koord=record x,y:real; end; function ff(q1,q2,q:koord):real; begin ff:=(q.x-q1.x)*(q2.y-q1.y)-(q.y-q1.y)*(q2.x-q1.x); end; function ss(q1,q2,q3:koord):real; begin ss:=abs((q2.x-q1.x)*(q3.y-q1.y)-(q3.x-q1.x)*(q2.y-q1.y))/2; end; var t1,t2,t3,t:koord; begin writeln('Input dots:'); writeln('A'); write('x='); readln(t1.x); write('y=');readln(t1.y); writeln('B'); write('x='); readln(t2.x); write('y=');readln(t2.y); writeln('C'); write('x='); readln(t3.x); write('y=');readln(t3.y); writeln('D'); write('x='); readln(t.x); write('y=');readln(t.y); if ff(t1,t2,t)*ff(t2,t3,t)*ff(t1,t3,t)<0 then write('in') else if ff(t1,t2,t)*ff(t2,t3,t)*ff(t1,t3,t)>0 then write('out') else if ss(t1,t2,t)+ss(t1,t3,t)+ss(t2,t3,t)-ss(t1,t2,t3)=0 then write('on') else write('out'); readln; end. --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

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

Вопрос № 87.099

дан текст, выделите в тексте заданные фрагменты (символов текста должно быть 512)

Отправлен: 16.05.2007, 00:57 Вопрос задал: Антон Ульянов (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Устинов С.Е. Здравствуйте, Антон Ульянов! Решение в приложении. Немного прокомментирую: m - количество символов текста (для проверки работы не обязательно набирать 512 символов - можно и меньше, но будет работать и для более чем 512 символов). Массив v будет хранить результат, который нужно вывести на экран. Его размер равен 3*m по тем соображениям, что можно "слову" присвоить один символ и только этим символом забить весь текст, тогда каждому введенному символу должно будет соответствовать 3 символа для вывода. Удачи! Приложение: const m=20; var s,r:string; v:array[1..m*3] of char; c:char; i,t,k:integer; procedure add(r:string); var i:integer; begin for i:=1 to length(r) do begin v[k]:=r[i]; k:=k+1; end; end; begin write('Vvedite slovo dlya vydeleniya: '); readln(s); t:=1; k:=1; r:=''; for i:=1 to m do begin read(c); r:=r+c; if (s[t]=c) then begin t:=t+1; if t>length(s) then begin add('{'+r+'}'); r:=''; t:=1; end; end else if (s[t]<>c) then begin add(r); r:=''; t:=1; end; if i=m then add(r); end; writeln; writeln('Reshenie:'); for i:=1 to k-1 do write(v[i]); readln; readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Практикант) Ответ отправлен: 16.05.2007, 03:49

Вопрос № 87.216

Здравствуйте! Помогите пожалуйста дописать курсовик. Надо выполнить операции над матрицей. В 6-м задании надо сформировать вектор, элементы которого представляют собой суммы элементов строк и столбцов, пеерсекающихся на соответствующих элементах главной диагонали. (исходная матрица=матрица полученная в 4 пункте, в коде все пункты выделены) в 7 задании, рассматривая строки и столбцы исходной матрицы как векторы, вычислить скалярное произведение строки и столбца, на пересечении которых находится наибольший по модулю элемент (предполагается, что такой элемент единственный) или хотя бы алгоритм напишите. Заранее спасибо Приложение: program kurs1; const n=3; m=3; k=1; x=2; type mas=array[1..n,1..m] of integer; mas1=array[1..n,1..m] of integer; mas2=array[1..n,1..m] of integer; var b,c,d,e,t:mas; i,j,q,w,i4,j4,y:integer; s1,s2,s3,s4,s5,s6,s7,s8:real; BEGIN c:=b; e:=d; for i:=1 to n do for j:=1 to m do begin write('VVEDITE ELEMEBTI MATRICI (',i,' ',j,') '); readln(b[i,j]); end; writeln; {èñõîäíàÿ ìàòðèöà} Writeln('SODERCHIMOE MATRICI DO OBRABOTKI'); for i:=1 to n do begin for j:=1 to m do write(b[i,j]:3); writeln; end; {îáðàáîòêà äëÿ ïîëó÷åíèÿ åäèíè÷íîé} for w:=1 to 1 do c[w,w]:=0; for q:=1 to 3 do c[q,q]:=1; Writeln('EDINICHNAYA MATRICA'); for q:=1 to n do begin for w:=1 to m do write(c[q,w]:3); writeln; end; writeln; for i:=1 to m do for j:=1 to n do d[i,j]:=b[i,j]-c[i,j]; writeln('RZNOST ISXODNOI I EDINICHNOI MATRIC:'); for i:=1 to m do begin for j:=1 to n do Write(d[i,j]:3); WriteLn; end; writeln; {==================================2==================================} Begin for i:=1 to 3 do e[1,1]:=d[1,1]; for i:=1 to 3 do e[1,2]:=0; for i:=1 to 3 do e[1,3]:=0; for i:=1 to 3 do e[2,1]:=0; for i:=1 to 3 do e[2,2]:=d[1,2]; for i:=1 to 3 do e[2,3]:=0; for i:=1 to 3 do e[3,1]:=0; for i:=1 to 3 do e[3,2]:=0; for i:=1 to 3 do e[3,3]:=d[1,3]; writeln('Äèàãîíàëüíàÿ ìàòðèöà '); for i:=1 to 3 do begin for j:=1 to 3 do write(e[i,j]:3); writeln; end; end; writeln; {==================================3==================================} Begin for i:=1 to 3 do t[i,i]:=e[i,i]*e[i,i]; for i:=1 to 3 do t[j,j]:=e[j,j]*e[i,i]; writeln('MATRICA VOZVEDTNNAYA V STEPEN M=2 '); for i:=1 to 3 do begin for j:=1 to 3 do write(t[i,j]:3); writeln; end; writeln; {==================================4==================================} if t[1,1]<0 then begin s1:=t[1,1]+t[1,2]+t[1,3]; end else begin write('CHISLO POLOZITELNO '); end; if t[2,2]<0 then begin s2:=t[2,1]+t[2,2]+t[2,3]; end else begin write('CHISLO POLOZITELNO '); end; if t[3,3]<0 then begin s1:=t[3,1]+t[3,2]+t[3,3]; end else begin write('CHISLO POLOZITELNO '); s4:=s1+s2+s3; Writeln('SUMMA ELEMETOV RAVNA: ',s4) end; writeln; {==================================5==================================} s5:=0; begin for i:=1 to n do for j:=1 to m do s5:=s5+t[i,j]; Writeln('Ñóììà ïîëîæèòåëüíûõ è îòðèöàòåëüíûõ ýëåìåíòîâ ðàâíà ',s5); end; end; writeln; {==================================6==================================} s6:=0; begin for i:=1 to 3 do for j:=1 to 1 do s6:=s6+t[i,j]; Writeln('SUMMA POLOZITELNIX I OTRIZATELNIX ELEMENTOV RAVNA ',s6); s7:=0; for i:=2 to 3 do for j:=2 to 1 do s7:=s7+t[i,j]; Writeln('SUMMA POLOZITELNIX I OTRIZATELNIX ELEMENTOV RAVNA ',s7); for i:=1 to 3 do for j:=1 to 1 do s8:=s8+t[i,j]; Writeln('SUMMA POLOZITELNIX I OTRIZATELNIX ELEMENTOV RAVNA ',s8); end; writeln; readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Мирослав! Смотрите приложение. Удачи! Приложение: program q87216; const n=3; type matrix=array[1..n,1..n]of integer; vector=array[1..n]of integer; var a:matrix; b,c,d:integer; e:vector; begin for b:=1 to n do for c:=1 to n do begin write('M[',b,',',c,']='); readln(a[b,c]); end; writeln; writeln('my matrix'); for b:=1 to n do begin for c:=1 to n do write(a[b,c]:5); writeln; end; writeln('point 6:'); for b:=1 to n do begin e[b]:=0; for c:=1 to n do begin e[b]:=e[b]+a[b,c]; e[b]:=e[b]+a[c,b]; end; end; for b:=1 to n do write(e[b]:5); writeln; writeln('point 7:'); d:=abs(a[1,1]); for b:=1 to n do begin e[b]:=1; for c:=1 to n do if d<abs(a[b,c])then d:=abs(a[b,c]); end; writeln('absolute maximum:',d); for b:=1 to n do for c:=1 to n do if d=abs(a[b,c])then begin for d:=1 to n do begin e[d]:=e[d]*a[b,d]; e[d]:=e[d]*a[d,c]; end; d:=-1; end; c:=0; for b:=1 to n do c:=c+e[b]; writeln('making scalar:',c); end. --------- И только наступив на грабли мы преобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Студент) Ответ отправлен: 17.05.2007, 12:31

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