Программы по pascal

1. Число совершенно, если оно равно сумме всех своих делителей, кроме самого себя. Пример: 6=1+2+3. Найдите все совершенные числа от 1 до 1000 и выведите их на экран. Подсказка: вам необходимо найти все делители от 1 до исследуемого числа. Делителем числа называется число, которое делит данное без остатка (a mod b=0).

const N = 1000;

var

    i,d,j,k,sum: integer;

    dv: array[1..N] of integer;

begin

    for i:=2 to N do begin

        //write(i,': ');

        d := 1;

        j := 1;

        while d < i do begin

            if i mod d = 0 then begin

                dv[j] := d;

                j := j+1;

                //write(d,',');

            end;

            d := d + 1;

        end;

        sum := 0;

        for k:=1 to j-1 do

            sum := sum + dv[k];

        if sum = i then

            writeln(i,' - perfect!');

       //writeln;

    end; 

 

readln;

end.

2) Возьмем любое натуральное число. Если оно четное - разделим его пополам, если нечетное - умножим на 3, прибавим 1 и разделим пополам. Повторим эти действия с вновь полученным числом. Гипотеза гласит, что независимо от выбора первого числа рано или поздно мы получим 1.

var

    n, i: word; 

 

begin

    for i:=20 to 30 do begin

        n := i;

        while n <> 1 do begin

            if (n mod 2) = 0 then

                n := n div 2

            else

                n := (3*n + 1) div 2;

            write(' |',n,'|');

        end;

        writeln; writeln; 

 

    end; 

 

readln;

end.

 

2. факториал

var

    factorial: longint;

    n, i: byte; 

 

begin

    write('n = '); readln(n); 

 

    factorial := 1; 

 

    for i:=2 to n do

        factorial := factorial * i; 

 

    writeln('n! = ', factorial); 

 

readln;

end.

Задача 1. Найти сумму n-го количества элементов ряда 1, -0.5, 0.25, -0.125, …

Задача 2. Найти сумму и количество элементов последовательности, которые по модулю больше 0.001. Последовательность: 
S = 1/2 - 2/4 + 3/8 - 4/16 + ... - ...

Задача 1. 

var

    a,sum: real;

    n,i:integer;

begin

    write('Количество элементов ряда: ');

    readln(n);

    a:=1;

    sum:=0;

    for i:=1 to n do begin

        sum:=sum+a;

        a:=-a/2

    end;

    writeln(sum:4:3);

readln

end.

Задача 2. 

var

        a, b, sign, n: integer;

        sum: real;

begin

        a := 1;

        b := 2;

        sign := 1;

        sum := 0;

        n := 0; 

 

        while a/b > 0.001 do begin

                sum := sum + sign * (a/b);

               n := n + 1;

                sign := -sign;

                a := a + 1;

                b := b * 2;

        end; 

 

        writeln('Sum: ', sum:5:3);

        writeln('Qty: ', n);

readln;

end.

 

 

 

1. Требуется скопировать данные из одного файла в другой, но в обратном порядке.

var

    f1, f2: file of char;

    c: char;

    arr: array [1..100] of char;

    k, i: integer; 

 

begin

    assign (f1, 'c:\file1.txt');

    reset (f1); 

 

    k := 1; 

 

    while not eof (f1) do begin

        read (f1, c);

        arr[k] := c;

        write (c:2);

        k := k + 1

    end; 

 

    assign (f2, 'c:\file2.txt');

    rewrite (f2); 

 

    for i := k-1 downto 1 do begin

        write (f2, arr[i])

    end; 

 

    close (f1);

    close (f2); 

 

    reset (f2); 

 

    writeln;

    while not eof (f2) do begin

        read (f2, c);

        write (c:2)

    end; 

 

readln

end.

Скопировать из одного файла  в другой только определенные символы (например, ряд гласных) и посчитать  их общее количество. var

    f1, f2: file of char;

    c: char;

    k: integer; 

 

begin

    assign (f1, 'c:\file1.txt');

    reset (f1); 

 

    assign (f2, 'c:\file2.txt');

    rewrite (f2); 

 

    k := 0; 

 

    while not eof (f1) do begin

        read (f1, c);

        if (c = 'a') or (c = 'e') or (c = 'u') then begin

            write (f2, c);

            k := k + 1

        end

    end; 

 

    close (f1);

    close (f2); 

 

    reset (f2); 

 

    while not eof (f2) do begin

        read (f2, c);

        write (c:2)

    end; 

 

    writeln;

    writeln (k); 

 

readln

end.

2. Осуществить запись одинаковых данных в типизированные и текстовый файлы. 
   Сравнить размер файлов.

var

    file_r: file of real;

    file_i: file of integer;

    file_t: text;

    i, n: integer;

    a: integer; 

 

begin

    assign(file_r,'c:/rfile.txt');

    assign(file_i,'c:/ifile.txt');

    assign(file_t,'c:/tfile.txt'); 

 

    rewrite(file_r);

    rewrite(file_i);

    rewrite(file_t); 

 

    write('n=');

    readln(n);

    for i:= 1 to n do begin

        write('a=');

        readln(a);

        write(file_r,a);

        write(file_i,a);

        write(file_t,a);

    end; 

 

    close(file_r);

    close(file_i);

    close(file_t); 

 

readln

end.