Скачиваний:
35
Добавлен:
01.05.2014
Размер:
1.1 Mб
Скачать

Конвейер

Для транспортирования материалов из цеха А в цех В используется конвейер. Материалы упаковываются в одинаковые контейнеры и размещаются на ленте один за одним в порядке изготовления в цехе А. Каждый контейнер имеет степень срочности обработки в цехе В. Для упорядочивания контейнеров по степени срочности используют накопитель, который находится в конце конвейера перед входом в цех В. Накопитель работает пошагово, на каждом шаге возможны следующие действия:

накопитель перемещает первый контейнер из ленты в цех В;

накопитель перемещает первый контейнер из строки в склад (в складе каждый следующий контейнер помещается на предыдущий);

накопитель перемещает верхний контейнер из склада в цех В.

Задание Написать программу PIPELINE, которая по последовательности контейнеров определит, можно ли упорядочить их по степени срочности пользуясь описанным накопителем.

Входные данные Входной текстовый файл PIPELINE.DAT в первой строке содержит количество тестов N. Далее следует N строк, каждый из которых описывает отдельный тест и содержит целое число K (1K10000) — количество контейнеров в последовательности и K действительных чисел — степеней срочности контейнеров в порядке их поступления из цеха А (меньшим числам соответствует большая степень срочности).

Пример входных данных

2

2 2.9 2.1

3 5.6 9.0 2.0

Выходные данные Каждая строка текстового файла PIPELINE.SOL должна содержать ответ для одного теста. Необходимо вывести 1, если необходимое упорядочивание возможно, или 0 в противном случае.

Пример выходных данных

1

0

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}

{$M 65384,0,655360}

const num = 10000;

type

plist=^tlist;

tlist=record

data:integer;

next:plist;

end;

lis = array [1..num] of real;

var

fi,fo,f:text;

ind:array [1..num] of integer;

s,k,n,t,i,j:integer;

list:plist;

buf:^lis;

procedure quicksort;

var i,j:integer;

procedure sswap(a,b:integer);

var t1:integer;

t2:real;

begin

t2:=buf^[a];buf^[a]:=buf^[b];buf^[b]:=t2;

t1:=ind[a];ind[a]:=ind[b];ind[b]:=t1;

end;

procedure ssort(l,r: integer);

var

i,j: integer;

x,y: real;

begin

i:=l; j:=r; x:=buf^[(l+r) DIV 2];

repeat

while buf^[i]<x do i:=i+1;

while x<buf^[j] do j:=j-1;

if i<=j then

begin

sswap(i,j);

i:=i+1; j:=j-1;

end;

until i>j;

if l<j then ssort(l,j);

if i<r then ssort(i,r);

end;

begin

read(fi,n);for j:=1 to n do read(fi,buf^[j]);

ssort(1,n);

end;

procedure destroyall(var list:plist);

var t:plist;

begin

while list<>nil do

begin

t:=list^.next;

dispose(list);

list:=t;

end;

end;

procedure destroy(var list:plist);

var t:plist;

begin

if list<>nil then

begin

t:=list^.next;

dispose(list);

list:=t;

end;

end;

procedure push(var list:plist;d:integer);

var t:plist;

begin

new(t);t^.data:=d;t^.next:=list;

list:=t;

end;

function pop(var list:plist):integer;

var t:tlist;

begin

if list<>nil then pop:=list^.data else pop:=-1;

end;

procedure sort;

var i,j:integer;

procedure swap(a,b:integer);

var t1:integer;

t2:real;

begin

t2:=buf^[a];buf^[a]:=buf^[b];buf^[b]:=t2;

t1:=ind[a];ind[a]:=ind[b];ind[b]:=t1;

end;

begin

read(fi,n);for j:=1 to n do read(fi,buf^[j]);

for i:=1 to n-1 do

for j:=i+1 to n do if buf^[i]>buf^[j] then swap(i,j);

end;

procedure init;

var i:integer;

begin

for i:=1 to num do ind[i]:=i;

list:=nil;

end;

procedure reind;

var index:array [1..num] of integer;

i:integer;

begin

for i:=1 to n do index[ind[i]]:=i;

for i:=1 to n do ind[i]:=index[i];

end;

begin

if paramstr(1)<>'' then assign(fi,paramstr(1))

else assign(fi,'pipeline.dat');reset(fi);

if paramstr(2)<>'' then assign(fo,paramstr(2))

else assign(fo,'pipeline.sol');rewrite(fo);

new(buf);

readln(fi,t);

for i:=1 to t do

begin

init;

quicksort;

{ for i:=1 to n do writeln(fo,ind[i]);close(fo);halt;}

reind;

k:=1;s:=1;

while s<n do

begin

while (buf^[pop(list)]<>buf^[s]) and (k<=n) do

begin

push(list,ind[k]);

inc(k);

end;

if buf^[pop(list)]=buf^[s] then

begin

destroy(list);

inc(s);

end;

if (k>n) and (buf^[pop(list)]<>buf^[s]) then break;

end;

if s<n then writeln(fo,0) else writeln(fo,1);

destroyall(list);

end;

close(fi);close(fo);

dispose(buf);

end.