program szek; var v:Array[1..100] of Integer; sz,dbsz,db,n:Integer; nev:Array[1..100] of String; kor:Array[1..100] of Integer; procedure kiir(k:Byte); var z,y:Byte; begin inc(db); for z:=1 to k do begin for y:=1 to n do if y=v[z] then Write(y,' '); end; if db mod 20=0 then begin WriteLn; end; WriteLn; end; function jo(k:Byte):Boolean; var ok:Boolean; x:Integer; begin ok:=True; for x:=1 to k-1 do if v[x]=v[k] then ok:=false; for x:=1 to k-1 do begin if(v[x]=v[x+1]+1)or(v[x]=v[x+1]-1) then ok:=False else if x>1 then if (v[x]=v[x-1]+1) or (v[x]=v[x-1]-1) then ok:=false; if (kor[v[x]]>kor[v[x]+1]+kor[v[x]]*1/5) or (kor[v[x]]>kor[v[x]-1]+kor[v[x]]*1/5) then ok:=false; end; jo:=ok; end; procedure back(i:Byte); var j:Byte; begin for j:=1 to n do begin v[i]:=j; if jo(i) then if i>=dbsz then kiir(i) else back(i+1); end; end; begin WriteLN('Kerem az emberek szamat:'); ReadLn(n); WriteLn('Kerem a szekek szamat:'); ReadLn(dbsz); {for sz:=1 to n do begin Write('Kerem az ',sz,'. ember nevet:'); ReadLn(nev[sz]); Write('Kerem az ',sz,'. ember korat:'); ReadLn(kor[sz]); end; } db:=0; back(1); If db=0 then WriteLn('Nincs megoldas') else WriteLn('Megoldasok szama:',db); ReadLn; end.