[eek]

программирование в Паскале

Первая программа:
Вычислить все делители целого положительного числа. Вывести их на экран (кроме себя самого и 1). Обеспечить проверку входных данных.

Решение:
program deliteli;
uses crt;
var a, b, s : real;
k, n : integer;
const q : word = 0;
Begin
{Блок проверки входных данных}
clrscr;
repeat
writeln ('Vvedite chislo (bolshe nula i cseloe): '
readln (a);
b := frac(a);
until (a > 0) and (b = 0);
{Сама программа}
n := round (a - 1);
for k := 2 to n do
Begin
s := frac(a/k);
if s = 0 then writeln(k);
if s = 0 then inc(q);
end;
if a > 10e7 then writeln ('Chislo slishkom bolshoe' else
if q = 0 then writeln('Chislo prostoe'
repeat until keyPressed;
end.

Вторая:
Составить рекурсивный алгоритм и написать программу вычисляющее значение фунции:
f(x) =
ln(x) + f ( ln(x) ) , x > 10^(-6)
0 , x <= 10^(-6)
Где фунция сверху и ноль снизу обьеденены в систему и х - вещественное число.
Определить форму рекурсивного алгоритма (спуск, возврат, спуск-возврат)

Решение:

Program rekursia;
uses crt;
var x : real;
f : extended;
{Блок рекурсии}
function fact(x : real) : extended;
const num : word = 0;
begin
inc(num);
if (num = 1) then writeln('Rekursia prohodit - ', num, ' raz'
else writeln('Rekursia prohodit - ', num, ' raza'
if (x <= 10e-6) then fact := 0 else
if (x = 0) or (x = exp(1)) then fact := 1
else fact := ln (x) + fact (ln (x));
end;
{Блок программы}
begin
clrscr;
writeln('Vvedite argument x: '
readln (x);
f := fact(x);
writeln ('Znachenie funcii dlai dannogo argumenta budet ravno: ', f:8:5);
repeat until keyPressed;
end.


Третья:
1) Создать файл заполненый вещественными числами из диапазона [0,1] Записать число М перед N-ым элементом такого файла, сдвинув N+1-ый, N+2-ой и т.д. элементы к концу файла (M и N задаются с клавиатуры).
Пример: Первоначальный файл: 0.0271 0.8762 0.4853 0.8744 0.8555
Число 0.7465 необходимо записать перед третьим элементом.
В результате получим в файле:
0.0271 0.8762 0.4853 0.7465 0.8744 0.8555
2) Вычислить контрольную сумму получаемого файла открыв его заново.
ЗАМЕЧАНИЕ: В програме запрещается заводить вспомогательные файлы и массивы.

Program fails;
uses crt;
Var nn : integer;
mainfile, buffer : file of real;
namef : string;
mainfilee : file;

procedure zapis (n : integer; name : string);
var i : integer; rand : real;
begin
assign (mainfile, name);
rewrite (mainfile);
for i := 1 to n do
begin
rand := random;
write (mainfile, rand);
writeln (' ', rand:4:2);
end;
end;

procedure pere_mes (n : integer; name : string);
var j, l, t, b, q : integer; f, v, k, a, p, y : real;
begin
Assign (mainfile, name);
reset (mainfile);
writeln ('Vvedite M:'
readln (v);
writeln ('Vvedite N:'
readln (b);
seek (mainfile, b);
read (mainfile, f);
seek (mainfile, b);
write (mainfile, v);
q := 1;
for j := b + 1 to n - 1 do
begin
if not eof (mainfile) then
if odd(q) then
k := y;
seek (mainfile, j);
read (mainfile, k);
seek (mainfile, j);
write (mainfile, f);
inc(q);
p := f;

if not odd(q) then
y := k;
seek (mainfile, j);
read (mainfile, p);
seek (mainfile, j);
write (mainfile, y);
inc(q);
f := p;
end;
seek (mainfile, 0);
while not eof (mainfile) do
begin
read (mainfile, a);
write (' ', a:4:2);
end;
close (mainfile);
end;

begin
clrscr;
Writeln ('Vvedite kolichestvo chisel: '
readln (nn);
Writeln ('Vvedite imja fjla: '
readln (namef);
zapis (nn, namef);
pere_mes (nn, namef);
assign (mainfilee, namef);
reset (mainfilee, 1);
repeat until keyPressed;
end.