program stack; const n=4; type spisok=^tpr; tpr=record inf:integer; link:spisok; end; {----------Dopolnitelnie peremennie--------} var BEGQA,BEGQB,ENDQA,ENDQB,p,p1,p2,T :spisok; first: boolean; i,k,max:byte; begin {-----------C03DAHUE CnUCK0B---------} begqa:=nil; begqb:=nil; new(p); writeln ('vvod 1 elementa spiska a'); readln(p^.inf); p^.link:=nil; Begqa:=p; endqa:=p; for i:=1 to n do begin new(p); writeln('vvedite element spiska a'); readln(p^.inf); p^.link:=nil; endqa^.link:=p; endqa:=p; end; new(p); writeln ('vvod 1 elementa spiska b'); readln(p^.inf); p^.link:=nil; Begqb:=p; endqb:=p; for i:=1 to n do begin new(p); writeln('vvedite element spiska b'); readln(p^.inf); p^.link:=nil; endqb^.link:=p; endqb:=p end; {Proverjaju v kakom spiske startovij element bolshij. Etot spisok PERVIJ} if begqa^.inf > begqb^.inf then begin p1 := begqa; p2 := begqb; max:=begqa^.inf; first := true; end else begin p1 := begqb; p2 := begqa; max:=begqb^.inf; first := false; end; {-------- Dalshe - sam algoritm -------- } while (p1 <> nil) and (p2 <> nil) do begin while (p1^.link <> nil) and (p1^.link^.inf > p2^.inf) do p1 := p1^.link; if p1^.link <> nil then begin T := p2^.link; p2^.link := p1^.link; p1^.link := p2; p2 := T; end; T := p1; p1 := p1^.link; end; { Ne zabivaem prilepit k koncu 1 spiska ostatok 2, esli on est' } T^.link := p2; { nu, i raspe4ataem sootvetstvenno tot spisok, kotorij 1 (sm. vishe) } if first then p := begqa else p := begqb; while p<>nil do begin write(' ',p^.inf); p:=p^.link; end; writeln; {------ vstavka max elementa posle k pozicii ------- } writeln(' vvedite poziciju k '); readln (k); new(p); p^.inf:=max; if first then p1 := begqa else p1 := begqb; for i:=1 to k-1 do p1:=p1^.link; p^.link:=p1^.link; p1^.link:=p; {---------- nu i opyat pe4at'-------------- } if first then p := begqa else p := begqb; while p<>nil do begin write(' ',p^.inf); p:=p^.link; end; writeln; readln; end.