Новые сообщения · Правила  
Страница 1 из 11
Модератор форума: Berestovskiy 
Форум ПРОГРАММИСТОВ » ПРОГРАММИРОВАНИЕ » Паскаль » Допоможіть будь ласка (Досконалі числа)
Допоможіть будь ласка
https://yadi.sk/i/FZQOqdXJkeoaD
https://yadi.sk/i/UfxNq8AYkeoan
https://yadi.sk/i/G-f3YYeqkeob8
https://yadi.sk/i/4OrShnRMkeobr
1 | Автор: Quasar | 2015-11-22, 22:45 | Изменено: Quasar - Вс, 2015-11-22, 22:48   |  Репутация: [ + 0 ]
Вам лучше написать условия сюда. Ссылки на сторонние ресурсы мы удаляем.
2 | Автор: admin | 2015-11-22, 22:47   |  Репутация: [ + 21 ]
2 | Автор: admin | 2015-11-22, 22:47   |  Репутация: [ + 21 ]
Ось код до першого завдання. Його можна оформити у вигляді процеди для знаходження досконалих чисел. Та доробити.
Код
Program sover;
uses crt;
var a, i, s: integer;
begin
clrscr;
write('Введіть ціле число а: ');
readln(a);
s:=0;
for i:=1 to a div 2 do
if a mod i=0 then
begin
s:=s+i;
write('+', i);
end;
if s=a then writeln(' Число ',a, 'досконале')
else writeln(' Число ', a, ' не досконале');
readln;
end.
3 | Автор: admin | 2015-11-22, 22:52   |  Репутация: [ + 21 ]
ось код до методу трапецій:
Код
program int_met_trap;
uses crt;
const epsilon:real=0.0001; a:real=0; b:real=6;
var
s:real;
function f(x:real):real;
{Подынтегральная функция}
begin
if x=0 then f:=1 else f:=sin(x)/x;
{Функции для тестирования}
{f:=sin(x)}
{f:=x*x;}
{f:=exp(-sqr(x));}
end;

function imetrap(a,b:real):real;
{Функция, реализующая метод трапеций }
var
n,i:longint;
s1,s2,h,v:real;
begin
n:=2; h:=(b-a)/n; s2:=0;
writeln('Промежуточные значения интеграла');
repeat
s1:=0;
for i:=1 to n-1 do s1:=s1+f(a+i*h);
s1:=(s1+f(a)/2+f(b)/2)*h;
{Промежуточные значения}
writeln(s1:9:7,', n=',n);
n:=2*n; v:=s2; s2:=s1; s1:=v;
h:=(b-a)/n
until abs(s2-s1)<epsilon;
{Результат}

imetrap:=s2;
end;
Begin
clrscr;
s:=imetrap(a,b);
writeln('Интеграл =',s:9:7,' с точностью ',epsilon:6:4);
readln
End.
4 | Автор: admin | 2015-11-22, 22:56   |  Репутация: [ + 21 ]
Ось код до методу ітераций. Необхідно вставити свою функцію та трохи переробити:
Код
Program metod_prostyh_iteraciy;
uses crt;
var x1,x0,eps:real; i:integer;
function f(x:real):real;
{Oписание функции}
begin
f:=2*x-cos(x)
end;
{Описание функциии fi(x) для итерационного
уравнения x=fi(x)}
function fi(x:real):real;
begin
fi:=cos(x)/2;
end;

{Описание метода итераций}
function iterac(var x0,e:real):real;
var n:integer;delta:real;
begin
n:=0;
writeln('Промежуточныe значения метода итераций');
repeat
delta:=abs(x0-fi(x0));
write('x', n:1, ' = ',x0:8:5,' fi(x',n:1, ')=',
fi(x0):8:5,' eps=',delta:8:5);
x0:=fi(x0);
n:=n+1; readln;
until (delta<e) or (n>300);
writeln('Число итераций =',n);
iterac:= x0
end;
begin
clrscr;
write('Начальное значение корня = ');readln(x0);
write('Точность вычисления корня = ');readln(eps);
x1:=iterac(x0,eps);
writeln('Приближенное значение корня с точностью ',eps:7:5);
writeln('x = ',x1:8:6);
readln
end.
5 | Автор: admin | 2015-11-22, 22:59   |  Репутация: [ + 21 ]
спасибі)
6 | Автор: Quasar | 2015-11-22, 23:51   |  Репутация: [ + 0 ]
Цитата Quasar ()
спасибі)
У нас підвищують репутацію за допомогу  wink
7 | Автор: admin | 2015-11-23, 00:11   |  Репутация: [ + 21 ]
Вычислить и вывести суму элементов массива, расположенных до первого отрицательного числа.

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

Вводится массив из 19 действительных чисел. Вычислить и вывести суму элементов, расположенных до первого отрицательного числа; если, отрицательные элементы в массиве отсутствуют, вывести сообщение(что их нет). После этого выводится запрос "Повторить выполнение программы?(Y/N)", если вводится 'Y', то программа повторяется, если 'N', то завершается.

Нельзя использовать стандартные функции, модули.
8 | Автор: Turk | 2015-11-24, 21:15 | Изменено: Turk - Вт, 2015-11-24, 21:16   |  Репутация: [ + 0 ]
Цитата Turk ()
Вычислить и вывести суму элементов массива, расположенных до первого отрицательного числа.


Код
PROGRAMM summa;

VAR
 m: ARRAY[1..19] of real; {декларация массива}
 i: integer; {параметр цикла FOR}
k:integer;{счетчик чисел}
 s: real; {сумма элементов}
p:char;
label metka;

BEGIN
metka:
 for i:=1 to 19 do {заполнение массива}
 Begin
   Write('Введите элемент последовательности N ',i);
   Readln(m[i]);
 End;

 s:=0; {обнуление счётчика суммы}
k:=0; {обнуление счетчика чисел}

 for i:=1 to 19 do 
begin
if  m [i]>0 then 
begin
s:=s+m[i]; {вычисление суммы}
     k:=k+1;{подсчет чисел}
    end
    else break;
end;

 Writeln('Сумма элементов последовательности равна ',s);
if  k=0 then Writeln('Отрицательных чисел нет');

 Write('Повторите выполнение программы? (Y/N)');
   Readln(p);

if  p='Y' then  goto metka;

END.
9 | Автор: babax | 2015-11-24, 22:03   |  Репутация: [ + 5 ]
9 | Автор: babax | 2015-11-24, 22:03   |  Репутация: [ + 5 ]
Форум ПРОГРАММИСТОВ » ПРОГРАММИРОВАНИЕ » Паскаль » Допоможіть будь ласка (Досконалі числа)
Страница 1 из 11
Поиск: