label 1; var a,b,c:array[0..100]of integer;n,i,j,k:integer; function yes:boolean; var l:integer; begin yes:=true; for l:=1 to j-1 do if a[l]=c[i]then exit(false) end; begin readln(n); while n>0 do begin fillchar(a,sizeof(a),0); for i:=1 to n do begin b[i]:=i; read(c[i]) end; a[1]:=1; k:=2; j:=1; for i:=1 to n do begin if yes then while a[j]<>c[i]do begin inc(j); a[j]:=b[k]; inc(k) end else begin writeln('No');goto 1 end; a[j]:=0; dec(j) end; if (a[1]=0)and(a[2]=0)then writeln('Yes'); 1: readln(n) end end. /************************************************************** Problem: 2119 User: admin Language: Pascal Result: Wrong Answer ****************************************************************/