1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
помогите плиз очень надо прога написана,вроде алгоритм правильный но где то ошибки и недочеты
Program stek_1; type Telem =integer; ukaz = ^zweno; zweno =record ELem: Telem; next:ukaz; end; stek=ukaz; var ust,ust1,ust2,ust3,g,g1,g2,g3:ukaz; a,EL,EL1,EL2,EL3:Telem; min1,min2,min3:integer; procedure wstek(var ust:stek; Nelem:Telem); var g:ukaz; begin New(g); g^.Next:=ust;ust:=g{?} end; procedure Isstek (var ust:stek; var a:Telem); var g:ukaz; begin if ust =nil then writeln('попытка выбора из пустого стека ') else begin a:=ust^.Elem; g:=ust; ust:=ust^.next; dispose(g) end ; end; Function outstak (var dukaz:ukaz):Telem; {?} var EL:ukaz; begin outstak:=dukaz^.Elem; EL:=dukaz; dukaz:=dukaz^.next; dispose(EL); end; BEGIN ust1:=nil;ust2:=nil;ust3:nil; writeln('введите элементы стека ч/з пробел, 0 и enter завершает ввод '); read (EL1); while EL1<=>0 do begin wstek(ust1,EL1); read(EL2); end; writeln; writeln(введите элементы стека ч/з пробел, 0 и enter завершает ввод'); read (EL2); while EL2<>0 do begin wstek(ust2,EL2); read(EL2); end; writeln; writeln('введите элементы стека ч/з пробел, 0 и enter завершает ввод'); read (EL3); while EL3<>0 do begin wstek(ust3,EL3); read(EL3); end; writeln; min1:=outstak(g1); while g1<>nil do begin EL1:=Outstak(g1); if(EL1<>min1)then min1:EL1; end; min2:=outstak(g2); while g2<>nil do begin EL2:=Outstak(g2); if(EL2<>min2)then min2:EL2; end; min3:=outstak(g3); while g3<>nil do begin EL3:=Outstak(g3); if(EL3<>min3)then min3:EL3; end; if (min1<=min2)then begin while (g2<>nil) and (g3<>nil) do begin EL2:=outstak(g2); EL3:=outstak(g3); end{?} if (EL2>EL3) then begin while ust1<>nil do begin Isstek(ust1,EL1); wstek(ust2,EL2); end{?} writeln; while ust2<>nil do begin Isstek(ust2,EL2); write(EL2,' '); end; writeln; end; else begin while ust1<>nil do begin Isstek(ust1,EL1); wstek(ust3,EL3); end{?} writeln; while ust3<>nil do begin Isstek(ust3,EL3); write(EL3,' '); end; writeln; end; else begin EL1:=outstak(g1); EL3:=outstak(g3); end{?} if (EL1>=EL3) then begin while ust2<>nil do begin Isstek(ust2,EL2); wstek(ust1,EL1); end{?} writeln; while ust1<>nil do begin Isstek(ust1,EL1); write(EL1,' '); end; writeln; end; else begin while ust2<>nil do begin Isstek(ust2,EL2); wstek(ust3,EL3); end{?} writeln; while ust3<>nil do begin Isstek(ust3,EL3); write(EL3,' '); end; writeln; end; end;end; if (min1>=min3)and(min2>=min3) then begin while (g1<>nil) and (g2<>nil) do begin EL1:=outstak(g1); EL2:=outstak(g2); end{?} if (EL1>EL2) then begin while ust3<>nil do begin Isstek(ust3,EL3); wstek(ust1,EL1); end{?} writeln; while ust1<>nil do begin Isstek(ust1,EL1); write(EL1,' '); end; writeln; end; else begin while ust3<>nil do begin Isstek(ust3,EL3); wstek(ust2,EL2); end{?} writeln; while ust2<>nil do begin Isstek(ust2,EL2); write(EL2,' '); end; writeln; end; end; end.
или вот файл сам
Сообщение отредактировано: pheonix - 10.04.2007 18:46