Добрый вечер!Помогите пожалуйста с одной задачкой:
По массиву А получить b,присвоив его-к-му элементу значение истина,если выполнено ниже условие,и значение false иначе:
а)если все элементы к-го столбца масива А-нулевые
б)элементы к-й строки массива А упорядочены по убыванию
в)к-я строка массива А симметрична

Отправлен: 31.01.2010, 08:46
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
а) uses crt; const nmax=20;{максимальный размер матрицы} var a:array[1..nmax,1..nmax] of integer;{матрица целых чисел} b:array[1..nmax] of boolean;{массив логического типа} m,n,j,k:byte;{размеры, счетчики} f:boolean;{переменная логического типа} begin clrscr; repeat{вводим размеры матрицы с проверкой диапазона} write(\'Количество строк до \',nmax,\' n=\'); readln(n); until n in [1..nmax]; repeat write(\'Количество столбцов до \',nmax,\' m=\'); readln(m); until m in [1..nmax]; writeln(\'Введите элементы матрицы:\'); for k:=1 to n do for j:=1 to m do begin write(\'a[\',k,\',\',j,\']=\');{вводим элементы} readln(a[k,j]); end; clrscr;{очищаем экран от ввода} writeln(\'Исходная матрица:\'); for k:=1 to n do begin for j:=1 to m do write(a[k,j]:4);{выводим матрицу как таблицу} writeln; end; for k:=1 to n do{проверяем все строки} begin f:=true;{считаем что они из нолей} for j:=1 to m do{идем по строке} if a[k,j]<>0 then{если не ноль} begin f:=false;{меняем значение переменной} break;{выходим из цикла} end; b[k]:=f;{записываем в массив} end; writeln(\'Массив В:\'); for k:=1 to n do write(b[k],\' \');{выводим массив} readln end. б). uses crt; const nmax=20; var a:array[1..nmax,1..nmax] of integer; b:array[1..nmax] of boolean; m,n,j,k:byte; f:boolean; begin clrscr; repeat write(\'Количество строк до \',nmax,\' n=\'); readln(n); until n in [1..nmax]; repeat write(\'Количество столбцов до \',nmax,\' m=\'); readln(m); until m in [1..nmax]; writeln(\'Введите элементы матрицы:\'); for k:=1 to n do for j:=1 to m do begin write(\'a[\',k,\',\',j,\']=\'); readln(a[k,j]); end; clrscr; writeln(\'Исходная матрица:\'); for k:=1 to n do begin for j:=1 to m do write(a[k,j]:4); writeln; end; for k:=1 to n do begin f:=true;{считаем что упорядочены строго по убыванию} for j:=2 to m do{смотрим со второго элемента} if a[k,j]>=a[k,j-1] then{если элемент больше или равен предущему} begin f:=false;{меняем значение} break; end; b[k]:=f; end; writeln(\'Массив В:\'); for k:=1 to n do write(b[k],\' \'); readln end. в). uses crt; const nmax=20; var a:array[1..nmax,1..nmax] of integer; b:array[1..nmax] of boolean; m,n,j,k:byte; f:boolean; begin clrscr; repeat write(\'Количество строк до \',nmax,\' n=\'); readln(n); until n in [1..nmax]; repeat write(\'Количество столбцов до \',nmax,\' m=\'); readln(m); until m in [1..nmax]; writeln(\'Введите элементы матрицы:\'); for k:=1 to n do for j:=1 to m do begin write(\'a[\',k,\',\',j,\']=\'); readln(a[k,j]); end; clrscr; writeln(\'Исходная матрица:\'); for k:=1 to n do begin for j:=1 to m do write(a[k,j]:4); writeln; end; for k:=1 to n do begin f:=true;{считаем что строка симметричная} for j:=1 to m div 2 do{смотрим от начала до середины} if a[k,j]<>a[k,m-j+1] then{если элементы симметрично от начала и конца разные} begin f:=false;{меняем значение} break; end; b[k]:=f; end; writeln(\'Массив В:\'); for k:=1 to n do write(b[k],\' \'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 31.01.2010, 15:11
Номер ответа: 259094

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259094 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Здравствуйте. Нужно написать программку, с помощью программы паскаль, которая должна анализировать содержание текстового файла с описанием переменных и определять, есть ли ошибка в этом описании.

Задание.
Анализ описания переменных
Создание программы для анализа описания переменных.

ВХОДНЫЕ ДАННЫЕ
На вход программы подается текстовый файл (с именем INPUT.TXT), содержащий только описания переменных на выбранном языке (Pascal или C).
Например, для языка Pascal содержание текстового файла может быть следующим:

var a, b, c: real;
d: array [1..6, 6..9] of integer;
s1: string;
s2: string[10];

То есть описание переменных начинается с ключевого слова «var», далее следуют списки имен переменных с указанием типа. В список типов необходимо включить наиболее часто используемые базовые типы. Тип может быть также массивом (в т.ч. многомерным) или строкой. У массива нижняя граница индекса не должна быть меньше верхней. Строка не может быть длиннее 255 символов.

Имя переменной — это последовательность букв и цифр, начинающаяся с буквы. Под буквами понимаются большие и малые буквы латинского алфавита (a…z, A…Z) и подчеркивание (_). Большинство современных компиляторов не имеют ограничений по длине имен переменных, однако значащими считаются только первые N символов (число N зависит от конкретного компилятора).

Например, если N = 8, то переменные a1234567 и a12345678 рассматриваются компиляторами как идентичные, хотя обе записи являются синтаксически верными. Значение числа N можно выбрать любое (N ≥ 1), но обычно это 8, 16, 32 и т.д.
В качестве разделителей, отделяющих друг от друга ключевые слова, имена переменных, знаки пунктуации и т.п., могут выступать:

пробелы (код ASCII — 32 или $20 в шестнадцатеричном виде);
переводы строк и возвраты кареток (коды ASCII — 10 ($0A) и 13 ($0D) соответственно);
табуляции (код ASCII — 9 или $09).
Для указания символа по его коду в языке Pascal используется знак «#». Либо для этих целей можно использовать функцию CHR (см. ее описание в файле справки компилятора языка Pascal). При указании букв A…F в шестнадцатеричных числах можно использовать как большие, так и малые буквы. Так, для проверки символа ch на возврат каретки можно написать
if ch = #13 …
или
if ch = #$0D …
или же
if ch = chr(13) …

Для языка C файл может быть таким:
double a[10], b, c;
int x_q[5][5];
То есть описание состоит из указаний типов данных со следующими за ними списками имен переменных. Язык C поддерживает различные модификаторы типов — модификаторы размера (long/short), знака (signed/unsigned) и прочие (auto, register, volatile, const, static). Для упрощения задачи будем рассматривать только модификаторы размера. Обратите внимание, что модификатор может использоваться без указания базового типа, в этом случае в качестве базового типа подразумевается тип int. Например, запись
long
эквивалентна з аписи
long int
Модификатор long может использоваться с типами int и double, модификатор short — только с типом int.
Т.к. язык C не делает различий между символом и целым числом (байтом), то для проверки кода числа можно просто сравнить символ с кодом:
if(ch == 13) …
Если компилятор выдает в этом случае предупреждение о возможном несоответствии данных, можно использовать явное преобразование типа:
if(ch == char(13)) …
Либо можно использовать запись ‘\OOO’ или ‘\xHH’, где OOO — восьмеричная запись кода символа (максимальный код — 3778), HH — шестнадцатеричная (максимальный код — FF16). Так, проверку на символ перевода строки можно также записать в таком виде:
if(ch == ‘\x0d’) …
или
if(ch == ‘\15’) …
В языке C существуют также специальные символы для обозначения некоторых непечатных элементов таблицы ASCII:
‘\n’ — перевод строки (next line);
‘\r’ — возврат каретки (carriage return);
‘\t’ — табуляция (tabulate);
Пробелы (как в Pascal, так и в C) можно обозначать просто в виде пробела, заключенного в кавычки (‘ ’).
В отличие от языка Pascal в языке C размерность масси ва указывается в виде одной цифры (обязательно положительной), и каждая размерность заключается в квадратные скобки.


ВЫХОДНЫЕ ДАННЫЕ
Ваша программа должна проанализировать имеющиеся в текстовом файле описания переменных и выдать (в текстовый файл OUTPUT.TXT или на экран) результат проверки. Это может быть:
1. Сообщение о том, что описание корректное.
2. Сообщение о синтаксической ошибке (неправильные имена переменных, ошибки при использовании ключевых слов, неверные индексы массивов, отсутствие знаков пунктуации и т.д.). Указывать тип ошибки не обязательно, требуется только указать строку и позицию в строке входного файла, где наблюдается ошибка. Достаточно находить только первую ошибку в описании.
3. Сообщение о дублировании имен переменных. В этом случае на выходе программы необходимо указать имя дублируемой переменной, а также строку и позицию в строке, где встретился дубликат.

Отправлен: 31.01.2010, 09:40
Вопрос задал: allxmiss, Посетитель
Всего ответов: 1
Страница вопроса »

program varible_3;

var input:text;
    line,position,err_line,err_pos:integer; //строка и позиция
    err_name:string;
    is_error:boolean=false;
    lines:array of string; //обрабатываемая стро
 ка

    startP,endP:string; //Начало и конец массива
    Prev_Pos:byte;

    name:array of string;
    name_nmb:integer;

    unexp_end:boolean=false;
    is_array:boolean=false;
    aft_str:boolean=false;
    aft_dots:boolean=false;

    temp_str:string;

    j:integer;
    var_str:string;
const
      //Предыдущий символ
  SEMICOLON        = 1;    //разделитель - ";" или ",". Т.е. кончилось объявление предыдущей переменной.
  STR
             = 2;    //переменная
  COLON            = 3;    // ":" или "OF"
  ARRAY_P          = 4;
  BRECKET_1        = 5;    // "[" или ".." или ","
  BRECKET_2        = 6;
  VAR_TYPE         = 8;
  NUMERIC          = 9;

  N = 8;
function separator(sep:char):boolean;
begin
  separator:=(sep = #32) or (sep=#9);
end;

function symb(smb:char):boolean;
begin
  symb := ((smb
 >='A') and (smb<='Z')) or
          ((smb>='a') and (smb<='z'));
end;

function get_str:string;
begin
  temp_str:='';
  while symb(lines[line][position]) do
    begin
      temp_str:=temp_str+lines[line][position];
      position:=position+1;
    end;
  get_str:=temp_str;
end;

function check(chkstr:string):boolean;
var i:integer;
    dots_str:string;
    keyword:array [1..6] of string;
label else_p_colon,

     else_p_num,
      else_p_brecket_1,
      else_p_brecket_2;

begin

    while separator(lines[line][position]) do
      begin
          position:=position+1;   //Вычитается ниже
          if lines[line][position]=#9 then err_pos:=err_pos+4-1; //плюс количество смволов в табуляции(обычно 4 или 8) и минус уже прибавленную до этого позицию
      end;
      
    if (lines[line][position]=#13) or
       (lines[line][positio
 n]=#10) or
       (lines[line][position]=#0)then
      begin
        check:=true;
        exit;
      end;

    case 
prev_pos of
      SEMICOLON:
                begin
                  unexp_end:=false;
                  keyword[1]:='STRING';
                  keyword[2]:='INTEGER';
                  keyword[3]:='REAL';
                  keyword[4]:='ARRAY';
                  keyword[5]:='OF';
                  keyword[6]:='VAR';
                  if (symb(lines[line][position])) or (lines[line][position]='_') then   //Если в теущий знак
может быть началом перменной
                    begin
                      name_nmb:=name_nmb+1;   //Увеличиваем счетчик имен пермеменных
                      setlength(name,name_nmb+1); //расширяем массив имен
                      while (symb(lines[line][position])) or
                            (lines[line][position]='_') or
                            ((lines[line][position]>='0') and (lines[line][position]<='9')) do
 
                        begin
                          name[name_nmb]:=name[name_nmb]+lines[line][position];
                          position:=position+1;
                        end;
                      for i:=1 to 6 do
                          if UpperCase(name[name_nmb])=keyword[i] then
                            begin
                              err_name:='Переменная не может быть ключевым словом - '+'"'+name[name_nmb]+'"';
        
                     err_line:=line;
                              err_pos:=err_pos+position -(length(name[name_nmb]));//Вроде так...
                              check:=false;
                              exit;
                            end;
                      delete(name[name_nmb],N+1,length(name[name_nmb])); //Значимыми являются только первые N символов - удаляем все, лишнее

                        for i:=1 to name_nmb-1 do         //Проверя
 ем нет объявлена ли переменная ранее. Можно обойтись и без вспомогательного массива. Но в этом случае алгоритм будет сложнее, а одна переменная типа string все равно понадобится. for i:=1 to line do if (pos(name,lines[i])<>0) and (pos(name,lines[i])<>(position-(name_pos-1))) then выводим ошибку;
                          if UpperCase(name[name_nmb]) = UpperCase(name[i]) then  //Имена перменных не чувствительны к регистру
                            begin     //Выводим ошибку
          
                   err_name:='Переменная с таким именем уже определена - '+'"'+name[name_nmb]+'"';
                              err_line:=line;
                              err_pos:=err_pos+position -(length(name[name_nmb]));//Вроде так...
                              check:=false;
                              exit;
                            end;
                      prev_pos:=STR;
                      check(li
 nes[line]);
                      exit;
                    end
                  else
                    begin
                      err_line:=line;
                      err_pos:=err_pos+position;
                      err_name:='Переменная не может начинаться с символа: '+'"'+lines[err_line][err_pos]+'"';
                      check:=false;
                      exit;
                    end;
                end;
      STR      :

               begin
                  if lines[line][position] = ',' then
                    begin
                      unexp_end:=true;
                      prev_pos:=SEMICOLON;
                      position:=position+1;
                      check(lines[line]);
                      exit;
                    end
                  else
                    if lines[line][position] = ':' then  
                      begi
 n
                        prev_pos:=COLON;
                        position:=position+1;
                        check(lines[line
]);
                        exit;
                      end
                  else     //ошибка
                    begin
                      err_line:=line;
                      err_pos:=err_pos+position;
                      err_name:='Ожидается "," или ":", а найдено '+'"'+lines[err_line][err_pos]+'"';
                      check:=false;
                      exit;
                    end;
                end;
 
    COLON    :
                begin
                  case UpCase(lines[line][position]) of
                    'A':
                        begin
                              if UpperCase(get_str) = 'ARRAY' then
                                begin
                                  prev_pos:= ARRAY_P;
                                  check(lines[line]);
                                  exit;
                              
   end
                              else
                                  goto else_p_colon;
                        end;
                    'S':
                        begin
                          if UpperCase(get_str) = 'STRING' then
                            begin
                              prev_pos:=VAR_TYPE;
                              aft_str:=true;
                              check(lines[line]);
                              exit;
  
                         end
                          else
                            goto else_p_colon;
                        end;
                    'I':
                        begin
                          if UpperCase(get_str) = 'INTEGER' then
                            begin
                              prev_pos:=VAR_TYPE;
                              check(lines[line]);
                              exit;
  
                           end
                          else
                            goto else_p_colon;
                        end;
                    'R':
                        begin
                          if UpperCase(get_str) = 'REAL' then
                            begin
                              prev_pos:=VAR_TYPE;
                              check(lines[line]);
                              exit;
                            end
   
                      else
                            goto else_p_colon;
                        end;
                  else
                    begin
else_p_colon:         err_name:='Ожидается "array" или тип переменной'; //Можно добавить вывод имени, встретившегося вместо переменной
                      err_line:=line;
                      err_pos:=err_pos+position-(length(temp_str));
                      check:=false;
   
                    exit;
                    end;
                  end;
                end;
      ARRAY_P  :
                begin
                  is_array:=true;
                  if lines[line][position] = '[' then         
                    begin
                      prev_pos:=BRECKET_1;
                      startP:='';
                      position:=position+1;
                      check(lines[line]);
                      exit;
      
             end
                  else
                    if (UpCase(lines[line][position])='O') then
                     begin
                      if UpperCase(get_str) = 'OF' then
                        begin
                          prev_pos:=COLON;
                          is_array:=false;
                          check(lines[line]);
                          exit;
                        end
                   
   end
                  else
                    begin
                       err_line:=line;
                       err_pos:=
err_pos+position;
                       err_name:='Ожидается "[", а найдено '+'"'+lines[err_line][err_pos]+'"';
                       check:=false;
                       exit;
                    end;
                end;
      BRECKET_1:      //  "["  ,  ".."  ,  ","
                begin
                  if (lines[line][position]>='0') and (lines[line][position]<='9') then
       
            begin
                      if (not aft_dots) or (aft_str) then //если двух точек не было ИЛИ это не строка
                        begin
                          while (lines[line][position]>='0') and (lines[line][position]<='9') do
                            begin
                              startP:=startP+lines[line][position];
                              position:=position+1;
                            end;<
 br>                          if aft_str then //Проверка длинны строки не может быть длиннее 255 сиволов
                              if StrToInt(startP) > 255 then
                                begin
                                  err_line:=line;
                                  err_pos:=err_pos+position;
                                  err_name:='Длинна строки не может быть больше 255';
                                  check:=false;
                               
  exit;
                                end;
                        end
                      else //если 2 точки были
                        begin
                          while (lines[line][position]>='0') and (lines[line][position]<='9') do
                            begin
                              endP:=endP+lines[line][position];
                              position:=position+1;
                            end
 ;
                          if StrToInt(endP) < StrToInt(startP) then  //Проверяем границы массива
                            begin
                                  err_line:=line;
                                  err_pos:=err_pos+position;
                                  err_name:='Верхняя граница массива не может быть меньше нижней';
                                  check:=false;
                                  exit;
                            end
          
             end;  
                      prev_pos:=NUMERIC;
                      check(lines[line]);
                      exit;
                    end
                  else //Если не цифра
                    begin
                       err_line:=line;
                       err_pos:=err_pos+position;
                       err_name:='Ожидается цифра, а найдено '+'"'+lines[err_line][err_pos]+'"';
       
                 check:=false;
                       exit;
                    end;
                end;
      NUMERIC  :
                begin
                  case lines[line][position] of
                    '.'       :
                               begin
                                if (not aft_str) and (not aft_dots) then
                                  begin
                                   while lines[line][position]='.' do    //Впринципе, можно
совместить с процедурой get_str
                                      begin
                                        dots_str:=dots_str+lines[line][position];
                                        position:=position+1;
                                      end;
                                   if dots_str = '..' then
                                    begin
                                          prev_pos:=BRECKET_1;
               
                            endP:='';
                                          aft_dots:=true;
                             
             check(lines[line]);
                                          exit;
                                    end
                                   else
                                    goto else_p_num;
                                  end
                                else
                                  begin
                                   err_line:=line;
                                   err_pos:=err_pos+position;
                                   if aft_str
then
                                    err_name:='Ожидается "]", а найдено '+'"'+lines[err_line][err_pos]+'"'
                                   else
                                    err_name:='Не ожидается "."';
                                   check:=false;
                                   exit;
                                  end;
                               end;

                    ','       :
                               begin
                                if (not aft_str) and (aft_dots) then   //Уже было ".."
                                  begin
                                    prev_pos:=BRECKET_1;
                                    startP:='';
                                    position:=position+1;
                                    aft_dots:=false;
                                    check(lines[line]);

                                   exit;
                                  end
                                else
                                  begin
                                   err_line:=line;
                                   err_pos:=err_pos+position;
                                   if aft_str then
                                    err_name:='Ожидается "]", а найдено '+'"'+lines[err_line][
 err_pos]+'"'
                                   else
                                    err_name:='Не ожидается ","';
                                   check:=false;
                                   exit;
                                  end;
                               end;
                    ']'       :
                               begin
                                if ((is_array) and (aft_dots)) or (aft_str) then
        
                         begin
                                   prev_pos:=BRECKET_2;
                                   aft_str:=false;
                                   aft_dots:=false;//************
                                   position:=position+1;
                                   check(lines[line]);
                                   exit;
                                  end
                                else
                  
                 goto else_p_num;
                               end;
                  else
else_p_num:         begin
                       err_line:=line;
                       err_pos:=err_pos+position;
                       if (not aft_dots) and (not aft_str) then
                        err_name:='Ожидается ".."'
                       else
                        if aft_str then
                         err_name:='Ожидается "]", а найдено
'+'"'+lines[err_line][err_pos]+'"'
                        else
                         err_name:='Ожидается "," или "]", а найдено '+'"'+lines[err_line][err_pos]+'"';
                       check:=false;
                       exit;
                    end;
                  end;
                end;
      BRECKET_2:
                begin
                  i
 f (lines[line][position]=';') and (not is_array) then   //Если не идет объявления массива
                    begin
        
              prev_pos:=SEMICOLON;
                      position:=position+1;
                      check(lines[line]);
                      exit;
                    end
                  else
                    if (UpCase(lines[line][position])='O') and (is_array) then   //Если идет объявление массива
                      begin
                        if UpperCase(get_str) = 'OF' then
                          begin
                            prev_pos:=COLON;

                           is_array:=false;
                            check(lines[line]);
                            exit;
                          end
                        else
                          goto else_p_brecket_2;
                      end
                  else
else_p_brecket_2:   begin
                       err_line:=line;
                       err_pos:=err_pos+position;
                       if not is_array
  then
                        err_name:='Ожидается ";", а найдено '+'"'+lines[err_line][err_pos]+'"'
                       else
                        err_name:='Ожидается "of", а найдено '+'"'+lines[err_line][err_pos]+'"';
                       check:=false;
                       exit;
                    end
                end;
      VAR_TYPE :
                begin
                 
if (lines[line][position] = '[') and (aft_str) then
                    begin
                      prev_pos:=BRECKET_1;
                      startP:='';
                      position:=position+1;
                      check(lines[line]);
                      exit;
                    end
                  else
                    if lines[line][position] = ';' then
                      begin
                    
     prev_pos:=SEMICOLON;  //unexp_end:=false;
                        position:=position+1;
                        check(lines[line]);
                        exit;
                      end
                    else
                      begin
                       err_line:=line;
                       err_pos:=err_pos+position;
                       if aft_str then
                        err_name:='Ожидается "[" или ";", а найдено '+'"'+lines[err_line][err_pos]+'"'

                      else
                        err_name:='Ожидается ";", а найдено '+'"'+lines[err_line][err_pos]+'"';
                       check:=false;
                       exit;
                      end;
                end;
    end;
end;
         //----------Начало программы----------//
begin
  err_name:='Ошибок не обнаружено';<
 br>  assignfile(input,'input.txt');
  reset(input);
  line:=0;

   while not EOF(input) do //Ищем начало объявлений
    begin
      line:=line+1;   //увеличиваем счетчик строк на 1
      setlength(lines,line+1); //Устанавливаем размер массива
      readln(input,lines[line]); //считываем строку
      j:=1;
      while (not symb(lines[line][j])) and
            (lines[line][j]<>#13) and
            (lines[line][j]<>#10) do j:=j+1;
      if (lines[line][j]=#13)
or
         (lines[line][j]=#10) then
            continue;
          while symb(lines[line][j]) do
            begin
              var_str:=var_str+lines[line][j];
              j:=j+1;
            end;
          if (UpperCase(var_str)='VAR') and ((  separator(lines[line][j]) or
               (lines[line][j]=#10) or
               (lines[line][j]=#13) ) and //следующий за ним символ - разделитель
             ( (separato
 r(lines[line][j-length(var_str)-1])or      // предыдущий - разделитель
               (lines[line][j-length(var_str)-1]=#10) or
    
           (lines[line][j-length(var_str)-1]=#13) or
               (lines[line][j-length(var_str)-1]=#0)) )) then //предыдущий - начало файла
            begin
              position:=j;
              break; //выходим из цикла - while
            end;
    end;

  prev_pos:=SEMICOLON;

      if check(lines[line]) then //Можно попробовать убрать фроверку отсюда и просто начинать следующий цикл с этого кода
        is_error:=false          //Но возникает проблема.
      else

       is_error:=true;
      if err_name='Ошибок не обнаружено' then  //Почему нужна эта проверка не знаю, но без нее не работало :-)
        is_error:=false;

   while (not eof(input)) and (not is_error) do //Если не конец файла и не ошибка
    begin
      line:=line+1;   //увеличиваем счетчик строк на 1
      setlength(lines,line+1);
      readln(input,lines[line]); //считываем строку
      position:=1;
      err_pos:=0;
    
   if check(lines[line]) then    //Проверка должна быть именно здесь, если ее поместить в начале цикла, то последняя строка небудет проверятся, т.к. обнаружится "OEF" - конец файла
        is_error:=false
      else
          if err_name<>'Ошибок не обнаружено' then  //Почему нужна эта проверка не знаю, но без нее не работало :-)
            begin
              is_error:=true;
              break;
            end
          else is_error:=false;      
   end;


  if ((prev_pos <> SEMICOLON) or (unexp_end)) and (not is_error) then
    begin
     err_line:=line;
     err_pos:=position;
     err_name:='Неожиданный конец файла';
    end;



  close(input);


  assignfile(output,'output.txt');
  Rewrite(output);

  writeln(output,err_name);
  if err_name<>'Ошибок не обнаружено' then
    writeln(output,'В позиции: '+IntToStr(err_line
 )+':'+IntToStr(err_pos));

  close(output);

end.

 vAr a, b, c: real; d: array [1..6, 6..9] of integer;
 s1: string;
s2: string[10];
f: array of real;
f4:array [1..1] of real
;
F4:string[255];

Переменная с таким именем уже определена - "F4"
В позиции: 7:1

Ответ отправил: Patriotix-N, 5-й класс
Ответ отправлен: 05.02.2010, 06:06
Номер ответа: 259226

Оценка ответа: 5
Комментарий к оценке:
Спасибо Вам, за знакомство,
Спасибо Вам за внимание,
Спасибо за работу.
Спасибо ещё раз за всё!!!

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259226 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Здравствуйте, прошу помочь в решении моей задачи. Писал в "Задачник" но что то не кто не ответил. Теперь попробую написать всем остальным(если я тут не чего не напутал) может хоть кто-то поможет. Есть код программы на нахождение минимуму функции(сам код прилагается). Так вот программа выводит на экран значение "min", надо дописать программу что бы среди этих "min" находилось самое наименьшее среди них. В приложении программа реализуюшая простой генетический алгоритм (селекция, скркшивание, мутация) для нахождения минимума функции Z(x,y)=x^2+y^2, -5.12<=x<=5.12, -5.12<=y<=5.12.

Отправлен: 31.01.2010, 10:52
Вопрос задал: Hivrenko, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program sga; uses crt; const maxpop = 100; maxstring = 30; dim = 2; {размерность пространства поиска} type allele = boolean; {Алель ? позиция в битовой строке} chromosome = array[1..maxstring*dim] of allele; {битовая строка} fenotype = array[1..dim] of real; individual = record chrom:chromosome; {генотип = битовая строка} x:fenotype; {фенотип = массив вещественных координат точки в пространстве поиска} fitness:real; {значение целевой функции} end; population = array[1..maxpop] of individual; const xmax:fenotype=(5.12,5.12); {массив максимальных значений для координат точки в про-странстве поиска} xmin:fenotype=(-5.12,-5.12); {массив минимальных значений для координат точки в про-странстве поиска} var oldpop, newpop, intpop :population; {Три непересекающихся популяции ? старая, новая и проме-жуточная} popsize, lchrom, gen, maxgen: integer; {Глобальные целые переменные} pcross, pmutation, sumfitness:real; {глобальные вещественные переменные} nmutation, ncross:integer; {Статистические целые} avg, max, min:real; {Статистические вещественные} min_of_min:real; {Вероятностные процедуры} function random_:real; begin random_ := random(65535)/(65535-1); end; function flip(probability:real):<WBR>boolean; {подбрасывание монетки ? true если орел} begin if probability = 1.0 then flip := true else flip := (random_ <= probability); end; function rnd(low,high:integer):integer; {Случайный выбор между low и high} var i:integer; begin if low >= high then i := low else begin i := trunc( random_ * (high-low+1) + low); if i > high then i := high; end; rnd := i; end; {интерфейсные процедуры: decode and objfunc} function objfunc(x:fenotype):real; begin objfunc:= sqr(x[1])+sqr(x[2]); end; procedure decode(chrom:chromosome; lbits:integer; var x:fenotype); {Декодирование строки в массив вещественных координат точки в пространстве поиска - true=1, false=0} var i,j:integer; f, accum, powerof2:real; begin for i:=1 to dim do begin accum := 0.0; powerof2 := 1; f:=1; for j := 1+lbits*(i-1) to lbits+lbits*(i-1) do begin if chrom[j] then accum := accum + powerof2; powerof2 := powerof2 * 2; f:=f*2; end; x[i] := xmin[i]+(xmax[i]-xmin[i])*<WBR>accum/(f-1) end end; {Расчет статистических величин: statistics } procedure statistics(popsize:integer; var max,avg,min,sumfitness:real; var pop:population); {Расчет статистик популяции } var j:integer; begin {Инициализация } sumfitness := pop[1].fitness; min := pop[1].fitness; max := pop[1].fitness; {Цикл для max, min, sumfitness } for j := 2 to popsize do with pop[j] do begin sumfitness := sumfitness + fitness; {Накопление суммы значений функции пригодности} if fitness>max then max := fitness; {Новое значение max} if fitness<min then min := fitness; {Новое значение min} end; {Расчет среднего} avg := sumfitness/popsize; end; {Процедура инициализации initpop} procedure initpop; {Инициализация начальной популяции случайным образом} var j, j1:integer; begin for j := 1 to popsize do with oldpop[j] do begin for j1 := 1 to lchrom*dim do chrom[j1] := flip(0.5); {Бросок монетки} decode(chrom,lchrom,x); {Декодирование строки} fitness := objfunc(x); {Вычисление начальных значений функции пригодно-сти} end; end; {3 генетических оператора: отбора (select), скрещивания (crossover) и мутации (mutation)} procedure select; {процедура выбора} var ipick:integer; procedure shuffle(var pop:population); {процедура перемешивания популяции в процессе отбора} var i,j:integer; ind0:individual; begin for i := popsize downto 2 do begin j:= random(i-1)+1; ind0:=pop[i]; pop[i]:=pop[j]; pop[j]:=ind0; end; end; function select_1:integer; var j1,j2,m:integer; begin if (ipick>popsize) then begin shuffle(oldpop); ipick:=1 end; j1:=ipick; j2:=ipick+1; if (oldpop[j2].fitness<oldpop[j1]<WBR>.fitness) then m:=j2 else m:=j1; ipick:=ipick+2; select_1:=m; end; var j:integer; begin ipick:=1; for j:=1 to popsize do begin intpop[j]:=oldpop[select_1]; end; oldpop:=intpop; end; function mutation (alleleval:allele; pmutation:real; var nmutation:integer):allele; {мутация одного бита в строке (аллеля) с вероятностью pmutation, count number of mutations} var mutate:boolean; begin mutate := flip(pmutation); {Flip the biased coin} if mutate then begin nmutation := nmutation + 1; mutation := not alleleval; {Change bit value} end else mutation := alleleval; {No change} end; procedure crossover(var parent1, parent2, child1, child2:chromosome; flchrom:integer; var ncross, nmutation, jcross:integer; var pcross, pmutation:real); {Скрещивание 2 родительских строк, результат помещается в 2 строках-потомках} var j:integer; begin if flip(pcross) then begin {Выполняется скрещивание с вероятностью pcross} jcross := rnd(1,flchrom-1); {Определение точки сечения в диапазоне между 1 и l-1} ncross := ncross + 1; {Инкрементирование счетчика скрещиваний} end else jcross := flchrom; {певая часть обмена , 1 to 1 and 2 to 2} for j := 1 to jcross do begin child1[j] := mutation(parent1[j], pmutation, nmutation); child2[j] := mutation(parent2[j], pmutation, nmutation); end; {вторая часть обмена, 1 to 2 and 2 to 1]} if jcross<>flchrom then {пропуск, если точка скрещивания равна flchrom--скрещивание не происходит} for j := jcross+1 to flchrom do begin child1[j] := mutation(parent2[j], pmutation, nmutation); child2[j] := mutation(parent1[j], pmutation, nmutation); end; end; {Процедура создания нового поколения: generation} procedure generation; {Генерирование нового поколения при помощи отбора, скре-щивания и мутации} {Прим: предполагается, что популяция имеет четный размер} var j, mate1, mate2, jcross:integer; begin select; j := 1; repeat {выполняются отбор, скрещивание и мутация, пока полно-стью не сформируется новая популяция ? newpop} mate1:= j; {выбор родительской пары} mate2:= j+1; {скрещивание и мутация ? мутация вставлена в процедуру скрещивания} crossover(oldpop[mate1].chrom, oldpop[mate2].chrom, newpop[j ].chrom, newpop[j + 1].chrom, lchrom*dim, ncross, nmutation, jcross, pcross, pmutation); {Декодирование строки и вычисление пригодности} with newpop[j ] do begin decode(chrom, lchrom,x); fitness := objfunc(x); end; with newpop[j+1] do begin decode(chrom, lchrom,x); fitness := objfunc(x); end; j := j + 2; until (j>popsize); end; begin { Главная программа } clrscr; popsize:=20; {размер популяции} lchrom:=20; {число битов на один кодируемый параметр} maxgen:=30; {максимальное число поколений} pmutation:=0.01; {вероятность скрещивания} pcross:=0.9; {вероятность мутации} {Инициализация генератора случайных чисел} randomize; {Инициализация счетчиков} nmutation := 0; ncross := 0; initpop; statistics (popsize, max, avg, min, sumfitness, oldpop); min_of_min:=min; gen:= 0; {Установка счетчика поколений в 0} repeat {Главный итерационный цикл} gen:= gen + 1; generation; statistics(popsize, max, avg, min, sumfitness, newpop); oldpop:= newpop; {переход на новое поколение } writeln(\'min= \',min); if min_of_min>min then min_of_min:=min; until (gen >= maxgen); writeln(\'minimum= \',min_of_min); readln; end. {End главной программы}

Ответ отправил: Лейла, 5-й класс
Ответ отправлен: 31.01.2010, 16:02
Номер ответа: 259096

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259096 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Добрый вечер!Уважаемые эксперты!Помогите решить пожалуйста вот такую задачу:
Дана вещественная матрица размером 7*7,все элементы которой различны.Найти скалярное произведение строки,в которой находится наибольший элемент матрицы,на столбец с наименьшим элементом.

Отправлен: 31.01.2010, 21:31
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Ответ отправил: riaman, 2-й класс
Ответ отправлен: 31.01.2010, 23:11
Номер ответа: 259105

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259105 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Добрый вечер,пожалуйста помогите решить одну вот такую задачу:
Получить массива В из массива А,удалением n-й строки и к-го столбца

Отправлен: 31.01.2010, 21:31
Вопрос задал: angel.nero, Посетитель
Всего ответов: 3
Страница вопроса »

Ответ отправил: riaman, 2-й класс
Ответ отправлен: 31.01.2010, 22:35
Номер ответа: 259104

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259104 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Ответ отправил: star9491, 5-й класс
Ответ отправлен: 01.02.2010, 17:30
Номер ответа: 259131

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259131 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
const n=5; m=5; var i,j,k,l,ii,jj:integer; a: array [1..n,1..m] of integer; {матрица NxM} b: array [1..n-1,1..m-1] of integer; begin randomize; ii:=1; jj:=1; repeat {защита против "дурака": k д.б. <= n, а l д.б. <= m} writeln(\'Enter k < \',n+1); readln(k); writeln(\'Enter l < \',m+1); readln(l); until ((k<=n) and (l<=m)); writeln(\'Massiv a:\'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); {заполняем матрицу случайными значениями} write(a[i,j]:4); {выводим матрицу A} end; writeln; end; writeln(\'Massiv b:\'); for i:=1 to n do begin for j:=1 to m do begin if (i<>k) and (j<>l) then begin b[ii,jj]:=a[i,j]; write(b[ii,jj]:4); inc(jj); if (jj>m-1) then {переход на новую строку...} begin inc(ii); jj:=1; writeln; end; end; end; end; readln; end.

Ответ отправил: Лейла, 5-й класс
Ответ отправлен: 01.02.2010, 18:19
Номер ответа: 259133

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259133 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Добрый день,уважаемые эксперты!!!!Помогите пожалуйста решить задачи на двумерные массивы
вот ссылка на задачу http://depositfiles.com/files/pe4ednfwl , номер задачи которую надо решить № 9.14 рис.3 (все случаи)

Отправлен: 31.01.2010, 22:01
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
а). uses crt; const n=9; var a:array[1..n,1..n] of real; s:real; i,j:byte; begin clrscr; randomize; writeln(\'Массив:\'); s:=0; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*random; if(i=1)or(i=n)or(j=1)or(j=n)then{периметр матрицы} begin textcolor(10);{выделим цветом} write(a[i,j]:5:2); s:=s+a[i,j];{посчитаем сумму} end else begin textcolor(15);{остальные цветом по умолчанию, у меня белый} write(a[i,j]:5:2); end; end; writeln; end; writeln; textcolor(15); write(\'Сумма в выделеной области=\',s:0:2); readln end. б). uses crt; const n=9; var a:array[1..n,1..n] of real; s:real; i,j:byte; begin clrscr; randomize; writeln(\'Массив:\'); s:=0; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*random; if(i=j)or(j=n-i+1)then{главная и побочная диагонали=крест} begin textcolor(10); write(a[i,j]:5:2); s:=s+a[i,j]; end else begin textcolor(15); write(a[i,j]:5:2); end; end; writeln; end; writeln; textcolor(15); write(\'Сумма в выделеной области=\',s:0:2); readln end. в) uses crt; const n=9; var a:array[1..n,1..n] of real; s:real; i,j,k:byte; begin clrscr; randomize; writeln(\'Массив:\'); s:=0; k:=n div 2+1; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*random; if(j>=i)and(j<=n-i+1){верхний треугольник} or (j<=i)and(j>=n-i+1)then{нижний треугольник} begin textcolor(10); write(a[i,j]:5:2); s:=s+a[i,j]; end else begin textcolor(15); write(a[i,j]:5:2); end; end; writeln; end; writeln; textcolor(15); write(\'Сумма в выделеной области=\',s:0:2); readln end. г). uses crt; const n=9; var a:array[1..n,1..n] of real; s:real; i,j,k:byte; begin clrscr; randomize; writeln(\'Массив:\'); s:=0; k:=n div 2+1;{середина матрицы нечетного порядка} for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*random; if(i<=k)and(j>=k-i+1)and(j<=k+i-1){верхняя часть} or (i>k)and(j>=i-k+1)and(j<=n-i+k) then{нижняя часть} begin textcolor(10); write(a[i,j]:5:2); s:=s+a[i,j]; end else begin textcolor(15); write(a[i,j]:5:2); end; end; writeln; end; writeln; textcolor(15); write(\'Сумма в выделеной области=\',s:0:2); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 01.02.2010, 09:11
Номер ответа: 259121

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259121 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Добрый вечер!Помогите пожалуйста вот с такой задачей:
дан двумерный массив,определить к-количество различных элементов массива (повторяющиеся элементы считать один раз)

Отправлен: 01.02.2010, 00:31
Вопрос задал: angel.nero, Посетитель
Всего ответов: 4
Страница вопроса »

Ответ отправил: riaman, 2-й класс
Ответ отправлен: 01.02.2010, 02:03
Номер ответа: 259114

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259114 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
cconst n=3; m=3; c=9; var i,j,ii,k,jj:integer; povtor: boolean; a: array [1..n,1..m] of integer; {матрица NxM} b: array [1..c] of integer; {в этой матрице будем хранить встретившиеся цифры, очевидно с не д.б. меньше n*m} begin randomize; ii:=1; k:=0; b[ii]:=-1000; for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10); {заполняем матрицу случайными значениями} for jj:=1 to ii do begin if b[jj]=a[i,j] then {смотрим, если такой элемент уже встречался, выход из цикла} begin povtor:=true; break; end; end; if povtor=false then begin k:=k+1; {если не встречался, прибавляем к счетчику} ii:=ii+1; b[ii]:=a[i,j]; {если такого элемента еще не было, добавляем в вектор b} end; povtor:=false; write(a[i,j]:4); {выводим матрицу} end; writeln; end; writeln(\'Count of different elements \',k); writeln(\'Vector b:\'); for i:=2 to k+1 do write(b[i]:4); writeln; readln; end.

Ответ отправил: Лейла, 5-й класс
Ответ отправлен: 01.02.2010, 02:47
Номер ответа: 259115

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259115 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
Uses Crt; Const Rows = 5; Columns = 5; Var Ar: Array[1..Rows, 1..Columns] of Integer; St, s: String; count, r, c: Byte; begin ClrScr; Randomize; {initialize varialble} St := \',\'; count := 0; for r:=1 to Rows do begin for c:=1 to Columns do begin Ar[r, c] := Random(30); Write(Ar[r, c]:5); end; WriteLn; end; {solving} for r:=1 to Rows do for c:=1 to Columns do begin Str(Ar[r, c], s); if (Pos(\',\'+s+\',\', St) = 0) then begin St := St + s + \',\'; Inc(count); end; end; {Debug info} { writeln(St); } {Type result} write(\'Found \', count, \' different numbers.\'); repeat until keypressed; end.

Ответ отправил: Andrew Kovalchuk, 2-й класс
Ответ отправлен: 01.02.2010, 14:01
Номер ответа: 259127

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259127 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

flg [b] := flg [b] + [n];

Приложение:
{ дан двумерный массив, определить к - количество различных элементов массива (повторяющиеся элементы считать один раз) } Program DifCount; Const N = 10; M = 10; cMax = 10; Type TArray = array [1..M, 1..N] of Word; TByteSet = set of Byte; TWordSet = array [0..255] of TByteSet; Var arr : TArray; flg : TWordSet; i : 1..M; j : 1..N; k : Word; Function notYet (a : Word) : Boolean; var b : Byte; n : Byte; begin b := a shr 8; n := a and 255; if n in flg [b] then notYet := false else begin Include (flg [b], n); notYet := true; end; end; Begin Randomize; { Заполняем массив случайными числами } for j := 1 to N do for i := 1 to M do arr [i, j] := Random (cMax); { Печатаем массив на экране } for j := 1 to N do begin for i := 1 to M do write (arr [i, j]:5, \' \'); writeln; end; { Инициализируем признаки для повторения элементов } for k := 0 to 255 do flg [k] := []; { Считаем количество различных элементов } k := 0; for j := 1 to N do for i := 1 to M do if notYet (arr [i, j]) then Inc (k); write (\'Количество различных элементов массива равно \', k); readln; End.

Ответ отправил: _Ayl_, Студент
Ответ отправлен: 01.02.2010, 14:25
Номер ответа: 259128

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259128 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »