type PRec = ^TRec; TRec = record key : integer; N,P : PRec; end; procedure Insert(a,b:Prec); begin b^.p^.n := b^.n; if (b^.n <> nil) then b^.n^.p := b^.p; a^.n^.p := b; b^.n := a^.n; a^.n := b; b^.p := a; end; procedure Bsort(L:PRec); var i,j,m : PRec; begin i := L; while (I^.N <> nil) do begin j := i^.N; M := J; while J <> NIL do begin if j^.key < m^.key then m:=j; j := j^.n; end; Insert(i,m); I := I^.n; end; end; procedure PrintN(L:Prec); begin while L <> nil do begin WriteLn(L^.Key); L := L^.N; end; end; procedure PrintP(L:PRec); var c : Prec; begin c := L; while c^.n <> nil do c:=c^.n; while c^.p <> nil do begin WriteLn(C^.key);c:=c^.p;end; end; var Li,eLi : PRec; mN : PRec; begin New(Li); Li^.n:=nil;Li^.p:=nil; eLi := Li; Assign(Input,'bsort.txt'); Reset(Input); while not eof do begin New(mN);Read(mN^.key); mN^.p := eLi; mN^.n := nil; eLi^.n := mN; eLi := mN; end; Close(Input); Assign(OutPut,'bsort.out'); Rewrite(Output); WriteLn('Not sorted, strait order:'); PrintN(Li^.N); WriteLn('Not sorted, reverse order:'); PrintP(Li); BSort(li); WriteLn('Sorted, strait order:'); PrintN(Li^.N); WriteLn('Sorted, reverse order:'); PrintP(Li); Close(OutPut); while Li<> nil do begin eLi := Li^.N; Dispose(Li); Li:=eLi; end; end.