Разработка системы задач (алгоритмы-программы) по дискретной математике — страница 14

выходит в строй футболист с наименьшим номером} If A[i]<=B[j] Then begin D[t]:=A[i]; Inc(i); end Else begin D[t]:=B[j]; Inc(j); end; Inc(t); end; {из одного автобуса вышли все футболисты, осталось выйти остальным} While i<=m do begin D[t]:=A[i]; Inc(i); Inc(t); end; While j<=q do begin D[t]:=B[j]; Inc(j); Inc(t); end; For i:=1 to t-1 do Write(D[i],' '); end; begin clrscr; Init('A:socker.txt'); Solve; readkey; end. 5 Задача о семьях. Uses crt; Const MaxN=1000; Var A:array[1..maxN]of byte; N, cnt,i,j:integer; Procedure Swap(var a,b:byte); Var c:byte; Begin c:=a; a:=b; b:=c; End; Begin Write(‘введите N’); readln(N); Write(‘введите массив

через пробел(0 – Петров, 1 - Иванов)’); For i:=1 to N do read(A[i]); i:=1; j:=N; cnt:=0; While i<j do If A[i]=1 then Inc(i) else If A[j]=0 then Dec(j) else begin Swap(A[i],A[j]); Inc(i); dec(j); Inc(cnt); End; writeLn(‘Число обменов - ’, cnt); End. 6 Метро. uses crt; const p=100; Type mas=array[1..p,1..p]of 0..1; var k,n:integer; A:mas; procedure Init(z:string); {инициализация данных} var f:text; i,j:integer; begin Assign(f,z); Reset(f); ReadLn(f,n); For i:=1 to n do begin For j:=1 to n do Read(f,A[i,j]); ReadLn(f); end; Close(f); end; procedure Get(i:integer); {i – номер станции, из которой необходимо отправится} var S,T:Set of 1..p; j,l:integer; begin T:=[i]; Repeat

S:=T; For l:=1 to n do If l in S then {по строкам матрицы смежности А, принадлежащим множеству S} For j:=1 to n do If A[l,j]=1 Then T:=T+[j]; {смотрим если есть путь из данного пункта в пункт j, то добавляем номер пункта j в множество Т} Until S=T; For j:=1 to n do If (j in T)and(i<>j) then Write(j,' '); {просматриваем содержится ли номер пункта j в множестве имеющих путь из пункта i} end; begin clrscr; Init('A:metro.txt'); readLn(k); Get(k); readkey; end. 7 Роботы. Program Robots; Const max=50; Type Sset=Set of 1..max; Mas=array[1..max]of Sset; Var A,B:Mas; {A – матрица

достижимостей, B[i] – какие роботы могут быть в i пункте} SOne, STwo: SSet; {SOne – роботы, которые едут со скоростью 1, STwo – роботы, которые едут со скоростью 2} N, M:integer; {N – число пунктов, M – число роботов} Procedure Init; {инициализация входных данных} Var K, i, FrP, ToP:integer; Begin FillChar(A,SizeOf(A),0); Write(‘Число пунктов:’); ReadLn(N); Write(‘Число дорог:’); ReadLn(K); For i:=1 to K do begin writeLn(‘Введите пункты, которые соединяет дорога №’, i); ReadLn(FrP, ToP); Include(A[FrP],ToP); Include(A[ToP],FrP); End; Write(‘Число

роботов:’); ReadLn(M); For i:=1 to M do Begin Write(‘Пункт, где находится робот №’,i,’:’); ReadLn(K); Include(B[k],i); Write(‘скорость робота №’,i,’:’); ReadLn(k); If K=1 then Include(SOne,i) Else Include(STwo,i); End; End; Function ProvCanMet: Boolean; Var i:integer; Begin i:=1; While (i<=N)and(B[i]<>[1..M])do Inc(i); ProvCanMet:=i<=N; End; Function InTwoNear: Boolean; Var i,j:integer; Begin i:=1; j:=N+1; while (i<N)and(j>N)do begin j:=i+1; while(j<=N)and Not((j in A[i])and(B[i]+B[j]=[1..M]))do Inc(j); Inc(i); End; InTwoNear:=j<=N; End; Function AddIfCan(mode:integer; S:Sset):Boolean; Var i,j:integer; C:mas; Begin AddIfCan:=false; {S – множество роботов, которые

едут} If mode=0 then For i:=1 to N do C[i]:=B[i]-S Else C:=B; For i:=1 to N do For j:=1 to N do If (i<>j)and(j in A[i])and(C[i]*B[j]*S<>B[j]*S) Then Begin AddIfCan:=true; C[i]:=C[i]+B[j]*S; End; B:=C; End; Function InTwoForC: byte; Var i,j:integer; Begin i:=1; j:=N+1; while (i<N)and(j>N)do begin j:=i+1; While (j<=N)and (not(j in A[i])or(B[i]+B[j]<>[1..m])or Not((SOne=[])or(STwo=[])or((B[i]*SOne=SOne)and(B[j]*STwo=STwo))or (B[j]*SOne=SOne)and(B[i]*STwo=STwo)))do Inc(j); Inc(i); End; If j>N Then InTwoForC:=0 Else If STwo=[] Then InTwoForC:=1 Else If SOne=[] Then InTwoForC:=2 Else InTwoForC:=3; End; Procedure SolveC; Var time:integer; FindS, IncS: Boolean; ForMet: integer; Begin Time:=0; IncS:=true; ForMet:=InTwoForC; FindS:=ProvCanMet; While IncS