{ Объявляем тип "указатель на слово" }
type pword = ^word;

{ Проверка на первый критерий }
function seqOK1(seq: pword; m: word): boolean;
var
    i, sum: word;
begin
    sum := 0;
    for i := 1 to m do
    begin
        sum := sum + seq[i];
    end;
    seqOK1 := sum >= m/2-2;
end;

{ на второй }
function seqOK2(seq: pword; m: word): boolean;
var i: integer;
begin
    { пропускаем слишком короткие последовательности }
    if (m < 2) then
    begin
        seqOK2 := true;
        exit;
    end;

    for i := 1 to m-1 do
    begin
        if (seq[i] = seq[i+1]) and (seq[i] = 1) then
        begin
            seqOK2 := true;
            exit;
        end;
    end;
    seqOK2 := false;
end;

{ на оба }
function seqOK(seq: pword; m: word): boolean;
begin
    seqOK := seqOK1(seq,m) and seqOK2(seq,m);
end;

{ генерируем случайную последовательность }
procedure makeSeq( seq:pword; m: word );
var i: word;
begin
    for i := 1 to m do
    begin
        seq[i] := random(2);
    end;
end;

var i: word;
var m: word;

var seq :^ word;
begin
    { инициализируем генератор случайных чисей }
    randomize();

    write( 'Введите m: ' );
    readln( m );

    { выделяем мапять на массив }
    GetMem( seq, m * sizeof(word) );
    { теперь seq указывает на начало области памяти, хранящей массив }

    repeat
        makeSeq( seq, m );  //  генерируем последовательность
    until seqOK(seq, m);    //  пока она не станет достаточно хороша

    { Вывод последовательности }
    for i := 1 to m do
    begin
        write( seq[i] );
    end;

    readln;
end.