Почему некоторые программы выдают ошибку выполнения?

Отредактировано Ваня Козаченко (2016-03-23 00:55:30)

Игра Жизнь

uses Utils,GraphABC;

const
  w =3;
  w1=1;
  k=20;
  m=300;
  n=220;
  graphW=0;
  mk=m div k;//15;
  nk=n div k;//10;
  mm=m+1;
  nn=n+1;
  x0=1;
  y0=21;
  ClearColor=clBlack;
  FillColor=clLimeGreen;
  FiledColor=RGB(0,40,0);
  FiledColor2=RGB(0,70,0);{}
  {ClearColor=clWhite;
  FillColor=clBlack;
  FiledColor=clLightGray;
  FiledColor2=clGray;{}
 

var
  //a,b,sosedia,sosedib: array [0..nn,0..mm] of byte;
  a,b,sosedia,sosedib:array of array of byte;
  //obnovA,obnovB: array [1..nk,1..mk] of boolean;
  obnovA,obnovB: array of array of boolean;
  count: integer;
  obn: boolean;
  mil,mil1: integer;
  hn,hm: integer;

procedure AssignArray(var arr:array of array of boolean; n,m:integer);
begin
  SetLength(arr,n);
  for var i:=0 to n-1 do
    SetLength(arr[i],m);
end;
procedure AssignArray(var arr:array of array of byte; n,m:integer);
begin
  SetLength(arr,n);
  for var i:=0 to n-1 do
    SetLength(arr[i],m);
end;
procedure CopyArray(arr1,arr2:array of array of byte);
begin
  for var i:=0 to arr1.Length-1 do
    arr1[i].CopyTo(arr2[i],0);
end;
procedure CopyArray(arr1,arr2:array of array of boolean);
begin
  for var i:=0 to arr1.Length-1 do
    arr1[i].CopyTo(arr2[i],0);
end;

procedure DrawCell(i,j: integer);
begin
  if BrushColor<>FillColor then begin
    SetBrushColor(FillColor);
    SetPenColor(FillColor);
  end;
  FillRect(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-w1,y0+i*w-w1);
end;

procedure ClearCell(i,j: integer);
begin
  if BrushColor<>clearColor then begin
    SetBrushColor(clearColor);
    SetPenColor(clearColor);
  end;
  FillRect(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-w1,y0+i*w-w1);
end;

procedure DrawConfiguration;
begin
  for var i:=1 to n do
    for var j:=1 to m do
      if a[i,j]=1 then
        DrawCell(i,j)
end;

procedure DrawField;
begin
  SetBrushColor(ClearColor);
  FillRectangle(x0,y0,x0+m*w,y0+n*w);
  SetPenColor(FiledColor);
  for var i:=0 to m do
    Line(x0+i*w-1,y0,x0+i*w-1,y0+n*w);
  for var i:=0 to n do
    Line(x0,y0+i*w-1,x0+m*w,y0+i*w-1);
  SetPenColor(FiledColor2);
  for var i:=0 to m div hm do
    Line(x0+i*w*hm-1,y0,x0+i*w*hm-1,y0+n*w);
  for var i:=0 to n div hn do
    Line(x0,y0+i*w*hn-1,x0+m*w,y0+i*w*hn-1);   
end;

procedure IncSosedi(i,j: integer);
begin
  var i1 := i=1 ? n : i-1;
  var i2 := i=n ? 1 : i+1;
  var j1 := j=1 ? m : j-1;
  var j2 := j=m ? 1 : j+1;
  SosediB[i1,j1] += 1;
  SosediB[i1,j]  += 1;
  SosediB[i1,j2] += 1;
  SosediB[i,j1]  += 1;
  SosediB[i,j2]  += 1;
  SosediB[i2,j1] += 1;
  SosediB[i2,j]  += 1;
  SosediB[i2,j2] += 1;
end;

procedure DecSosedi(i,j: integer);
begin
  var i1 := i=1 ? n : i-1;
  var i2 := i=n ? 1 : i+1;
  var j1 := j=1 ? m : j-1;
  var j2 := j=m ? 1 : j+1;
  SosediB[i1,j1] -= 1;
  SosediB[i1,j]  -= 1;
  SosediB[i1,j2] -= 1;
  SosediB[i,j1]  -= 1;
  SosediB[i,j2]  -= 1;
  SosediB[i2,j1] -= 1;
  SosediB[i2,j]  -= 1;
  SosediB[i2,j2] -= 1;
end;

procedure SetCell(i,j: integer);
begin
  if b[i,j]=0 then
  begin
    b[i,j]:=1;
    obn:=true;
    IncSosedi(i,j);
  end;
  count += 1;
end;

procedure UnSetCell(i,j: integer);
begin
  if b[i,j]=1 then
  begin
    b[i,j]:=0;
    obn:=true;
    DecSosedi(i,j);
  end;
  count -= 1;
end;

type
  ColonyType = (Big, LD, RD, LU, RU);
procedure AddColonyType(xc,yc:integer; ctype:ColonyType);
begin
case ctype of
    ColonyType.Big:begin
      SetCell(xc,yc);
      SetCell(xc,yc+1);
      SetCell(xc,yc+2);
      SetCell(xc-1,yc+2);
      SetCell(xc+1,yc+1);
    end;
    ColonyType.LD:begin
      SetCell(xc,yc-1);
      SetCell(xc,yc);
      SetCell(xc,yc+1);
      SetCell(xc-1,yc-1);
      SetCell(xc-2,yc);     
    end;
  end;
  //SosediA:=SosediB;
  CopyArray(sosedib,sosedia);
  for var ik:=1 to nk do
    for var jk:=1 to mk do
      obnovB[ik,jk]:=true;
  //obnovA:=obnovB;
  CopyArray(obnovB,obnovA);
end;

procedure Init;
begin
  Count:=0;
  AddColonyType(n div 2,m div 2, ColonyType.Big);
end;

procedure OnlyCase(i,j: integer);
begin
case SosediA[i,j] of
0..1,4..9:
    if b[i,j]=1 then
    begin
      b[i,j]:=0;
      obn:=true;
      DecSosedi(i,j);
      ClearCell(i,j);
      count -= 1;
    end;
3: if b[i,j]=0 then
    begin
      b[i,j]:=1;
      obn:=true;
      IncSosedi(i,j);
      DrawCell(i,j);
      count += 1;
    end;
  end;
end;

procedure NextGen;
var
  i,j,ik1,jk1,ik2,jk2,ifirst,jfirst,ilast,jlast: integer;
  l,r,u,d,lu,ld,ru,rd: boolean;
begin
    for var ik:=1 to nk do
    begin
      for var jk:=1 to mk do
      begin
        obn := false;
        ifirst := (ik-1)*hn+1;
        ilast  := ik*hn;
        jfirst := (jk-1)*hm+1;
        jlast  := jk*hm;
        if obnovA[ik,jk] then
        begin
          for i:=ifirst to ilast do
            for j:=jfirst to jlast do
              OnlyCase(i,j);
        end
        else
        begin
          ik1 := ik=1 ? nk : ik-1;
          ik2 := ik=nk ? 1 : ik+1;
          jk1 := jk=1 ? mk : jk-1;
          jk2 := jk=mk ? 1 : jk+1;
          l:=obnovA[ik,jk1];
          r:=obnovA[ik,jk2];
          u:=obnovA[ik1,jk];
          d:=obnovA[ik2,jk];
          lu:=obnovA[ik1,jk1];
          ld:=obnovA[ik2,jk1];
          ru:=obnovA[ik1,jk2];
          rd:=obnovA[ik2,jk2];
          if u then
          begin
            i:=ifirst;
            for j:=jfirst+1 to jlast-1 do
              OnlyCase(i,j);
          end;
          if d then
          begin
            i:=ilast;
            for j:=jfirst+1 to jlast-1 do
              OnlyCase(i,j);
          end;
          if l then
          begin
            j:=jfirst;
            for i:=ifirst+1 to ilast-1 do
              OnlyCase(i,j);
          end;
          if r then
          begin
            j:=jlast;
            for i:=ifirst+1 to ilast-1 do
              OnlyCase(i,j);
          end;
          if u or l or lu then
            OnlyCase(ifirst,jfirst);
          if u or r or ru then
            OnlyCase(ifirst,jlast);
          if d or l or ld then
            OnlyCase(ilast,jfirst);
          if d or r or rd then
            OnlyCase(ilast,jlast);
        end;
        obnovB[ik,jk]:=obn;
      end;
    end;
end;

procedure MouseDown(x,y,b:integer);
begin
  case b of
    1:AddColonyType((y-y0)div w,(x-x0)div w, ColonyType.LD);
   
  end;
end;

begin
  SetConsoleIO;
  AssignArray(obnovA,nk+1,mk+1);
  AssignArray(obnovB,nk+1,mk+1);
  AssignArray(a,nn+1,mm+1);
  AssignArray(b,nn+1,mm+1);
  AssignArray(sosedia,nn+1,mm+1);
  AssignArray(sosedib,nn+1,mm+1);
  SetWindowCaption('Игра "Жизнь"');
  if (m mod mk<>0) or (n mod nk<>0) then
  begin
    writeln('Размер кластера не согласован с размером поля. Программа завершена');
    exit
  end;
  hm:=m div mk;
  hn:=n div nk;
  SetBrushColor(ClearColor);
  SetWindowSize(x0+m*w,y0+n*w+graphW);
  CenterWindow;
  ClearWindow(ClearColor);
  SetFontName('Courier New');
  SetFontSize(10);
  Init;
  DrawField;
  DrawConfiguration;
  OnMouseDown:=MouseDown;
  mil:=Milliseconds;
  var gen:=0;
  DrawInBuffer := false;
  while true do begin
    gen+=1;
    //SosediA:=SosediB;
    //obnovA:=obnovB;
    CopyArray(sosedib,sosedia);
    CopyArray(obnovB,obnovA);
    NextGen;   
    if gen mod 10 = 0 then begin
      DrawInBuffer := True;
      SetBrushColor(ClearColor);
      SetFontColor(FillColor);
      TextOut(25, 0,'Поколение: '+IntToStr(gen));
      TextOut(765,0,'Жителей: '+IntToStr(count)+'    ');
      if gen mod 1000 = 0 then begin
        mil1:=Milliseconds;
        writeln(gen,'  ',(mil1-mil)/1000);
        mil:=mil1;
      end;
      DrawInBuffer := false;
    end;
  end;
end.

Сортировка вагонов – B

prb4513   К тупику со стороны пути 1 (см. рисунок) подъехал поезд. Разрешается отцепить от поезда один или сразу несколько первых вагонов и завезти их в тупик (при желании, можно даже завезти в тупик сразу весь поезд). После этого часть из этих вагонов вывезти в сторону пути 2. После этого можно завезти в тупик еще несколько вагонов и снова часть оказавшихся вагонов вывезти в сторону пути 2. И так далее (так, что каждый вагон может лишь один раз заехать с пути 1 в тупик, а затем один раз выехать из тупика на путь 2). Заезжать в тупик с пути 2 или выезжать из тупика на путь 1 запрещается. Нельзя с пути 1 попасть на путь 2, не заезжая в тупик.

Известно, в каком порядке изначально идут вагоны поезда. Требуется с помощью указанных операций сделать так, чтобы вагоны поезда шли по порядку (сначала первый, потом второй и т. д., считая от головы поезда, едущего по пути 2 в сторону от тупика). Напишите программу, определяющую, можно ли это сделать.

Технические условия

Входные данные

Вводится число N — количество вагонов в поезде \left(1\leq N\leq100\right). Дальше идут номера вагонов в порядке от головы поезда, едущего по пути 1 в сторону тупика. Вагоны пронумерованы натуральными числами от 1  до N, каждое из которых встречается ровно один раз.

Выходные данные

Если сделать так, чтобы вагоны шли в порядке от 1  до N, считая от головы поезда, когда поезд поедет по пути 2 из тупика, можно, выведите сообщение YES, если это сделать нельзя, выведите NO.

Код

C++

#include <iostream>
using namespace std;
struct stack{                           //стек
int truck[100];
int length = 0;
int pop (){return truck[--length];}
void push (int x){truck[length++] = x;}
int front () {return truck[length-1];}
int size () {return length;}
}car;
int main() {
int amount_n;
cin >> amount_n;                 //Ввод (количество вагонов)
int n;
int count = 1;
while (cin >> n){                //Цикл (для ввода нового вагона)
    car.push(n);             //заводим в стек новый вагон
    if (n == count){count++; car.pop();} //проверяем, если вагон подходит, то выводим его на путь 2
    while (car.size() > 0){  //т.к. перед подходящим вагоном может стоять следующий подходящий вагон или несколько вагонов ,то пока стек не пуст будем проверять последние вагоны в стеке
    if (car.front() == count){count++; car.pop();} //если вагон подходит выводим на путь 2
    else break;
    }
}

if (car.size() == 0) {cout << "YES" << endl;} //если стек пуст, то все вагоны были выведены на путь 2
else cout << "NO" << endl;

return 0;
}

// Клонирование графических объектов
uses ABCObjects,GraphABC;

var bt: TextABC;
 
begin
  var x := 224;
  bt := new TextABC(60,110,110,'Привет!',RGB(x,x,x));
  while x>32 do
  begin
    Sleep(40);
    x -= 32;
    bt := bt.Clone;
    bt.Color := RGB(x,x,x);
    bt.MoveOn(7,7);
  end;
end.