Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  lab4
Language: PASCAL
Code:
program lab_4;
uses
     Crt;
const
     max_N = 20;
     z_i: array [boolean] of char = ('0', '1');
var
     N, p, st, t, i, j, count: integer;
     B: array [1..max_N] of boolean;
     A: array [1..max_N] of char;
     c: char;
     g: text;
     ad: boolean;
begin
     clrscr;
     writeln('Лабораторная работа №4');
     writeln;
     ad := false;
     repeat
          write('Введите мощность множества N = ');
          {$I-}readln(N);{$I+}
          if IoResult = 0 then
          begin
               if (N >= 1) and (N <= max_N) then
                    ad := true
               else
                    writeln('Мощность множества должна находиться в интервале [1..', max_N, ']');
          end
          else
               writeln('Ошибка ввода. Неверный формат!');
     until ad;

     writeln('Введите элементы множества A');
     i := 1;
     while i <= N do
     begin
          write('Элемент ', i, ' = ');
          readln(c);
          ad := true;
          for j := 1 to i - 1 do
               if A[j] = c then
               begin
                    ad := false;
                    writeln('Элемент введен повторно, введите другое значение');
               end;
          if ad then
          begin
               A[i] := c;
               inc(i);
          end;
     end;
     writeln;

     for i := 1 to N do
          B[i] := false;
     st := 1 shl n;
     count := 0;
     assign(g,'output.txt');
     rewrite(g);
     for j := 1 to st - 1 do
     begin
          i:=j;
          p:=1;
          while (i and 1) = 0 do
          begin
               inc(p);
               i := i shr 1;
          end;
          B[p] := not B[p];
          write(g,j,' ');
          write(j,' ');
          for i := N downto 1 do
          begin
               write(g, z_i[B[i]]);
               write(z_i[B[i]]);
          end;
          write(g,' {');
          write(' {');
          ad := false;
          for i := N downto 1 do
               if B[i] then
               begin
                    if ad then
                    begin
                         write(', ');
                         write(g,', ');
                    end
                    else
                         ad := true;

                    write(A[N-i+1]);
                    write(g,A[N-i+1]);
               end;
          writeln('}');
          writeln(g,'}');
          inc(count);
          if (count mod 20) = 0 then
          begin
               writeln('Нажмите любую клавишу...');
               readkey;
               clrscr;
          end;
     end;

     close(g);
     writeln('Результат сохранен в файл output.txt в каталоге с программой');
     ReadKey;
end.
Comments: