model mimod
	uses "mmxprs", "mmsystem"
	declarations
	    kmanz   = 9999    	! # de Manzanas 
	    kclust  = 50     	! Dimensionalidad de Clusters
	    krutas  = 50      	! # de Rutas	    

  		manz = 1..kmanz
  		clust = 1..kclust
  		
	    ktol = 0              	!0.001
	    kmotor = XPRS_BAR
    	zcosto: real
    	zmanz,zmanz2,zveci,zclust,zclust2,wclust,wclust2,wclust3,wcont,wmanz,wimay,zi,hcont1,hcont2,kcopia,zrest,kborr,wib,minclust,kpool: integer
    	zctes,zvtas,wctes,wvtas,wzctes,wzvtas,zfill: integer
    	totctes,totvtas,zdist,kfactor,kwtol,hctes,hzctes,hvtas,hzvtas,gctes,gzctes,gvtas,gzvtas,zkern,mptol: real 
    	wsale,wsigue: boolean

    	ctes: dynamic array(manz) of integer
    	vtas: dynamic array(manz) of integer
    	costo: dynamic array(clust,manz) of real
    	bounds: dynamic array(manz,manz) of boolean
    	allocmanz: dynamic array(manz) of integer 
		alloclust: dynamic array(range) of integer
    	   	
    	asigna: dynamic array(clust,manz) of mpvar
    	hrstrai: mpvar    	    	

    	wzrest: array(range) of linctr
    	wmrest: array(range) of linctr
    	asigobj: linctr

		zcompact: array(1..300) of integer
		clon: dynamic array(manz) of boolean
		wsol: array(1..10) of real

		mybasis:basis
  	end-declarations

!*********************************************************************************** 	
! Version: 9999
	kfactor := krutas * 0.06 	  	! 0.055 (Queda muy estrangulado)
	zkern := 0.00             		! 0.25
	kpert := 0						! 0: NO, 1: SI  (Forzar Convergencia)
	zpeso := 0
!*********************************************************************************** 	
	kwtol := 0.10 	 				! 0.10
  	kmaxtime := 20					! 50	
	mptol := 0.001*1                ! 0.001	
	kcuts1 := true
!*********************************************************************************** 	
	klimarc := 0.50 				! 0.30 - 0.35
	kdbarra := false 				! 0: NO, 1: SI  (Activa Cota Superior por Cluster) 
	kfobj := 1						! 0: Miz z<=Ax	1:Min Sum(Cij*Xij)
	kumbral := 1					! <kumbral Xij, >=kumbral Xij*(klimarc-Cij)
!*********************************************************************************** 	
	ksqr := false     	          	! true
	kdin := true
	kpeso := 1.0					! 1.0 
!*********************************************************************************** 	
  	!setparam("XPRS_MIPPRESOLVE",0)        ! +1=Reduce Cost, +2=Logical Bin, +4=Probing Bin
  	!setparam("XPRS_SBBEST",0)              ! DISABLE STRONG BRANCHING
!*********************************************************************************** 	

!*********************************************************************************** 	
! SOLUCION GENERADA MEDIANTE HEURISTICA: COTA SUPERIOR
!*********************************************************************************** 	
	! El DBARRA es igual para todos los clusters
	! zlimsup := 0.0581297           (ROGER)   
	! zlimsup := 0.0485903*1.05      ! (F1)
	! zlimsup := 0.0531561*1.01    
	! zlimsup := 0.051782*1.01         
	!zlimsup := 0.0516064*1.01
	zlimsup := 0.0586544*1.01
  	
	if ksqr then
		zlimsup := (10*zlimsup)^2
	end-if	
		
	if kdbarra then
		wdbarra := 1.0
	else
		wdbarra := 1000.0		
	end-if		
	
	forall(i in clust) werr_clust(i) := true
	
	if kdbarra then
		wdbarra := 1.0
	else
		wdbarra := 1000.0		
	end-if		
!*********************************************************************************** 	
! BOUNDS.TXT (PARA 4k) SE GENERA DESDE JFLP2.MB
!*********************************************************************************** 	
	forall(i in clust) actclust(i) := true
	forall(j in manz) work(j) := true

  	fopen("BOUNDS2.TXT",F_INPUT)
  	repeat
  		readln(zmanz,",",zmanz2)
  		if (getparam('nbread') = 3) and work(zmanz) and work(zmanz2) then
			bounds(zmanz,zmanz2) := true
		end-if	
  	until (getparam('nbread') < 3)
  	fclose(F_INPUT)

	totctes := 0
	totvtas := 0	
  	fopen("MATRIX-4K.TXT",F_INPUT)
  	repeat
  		readln(zmanz,",",zctes,",",zvtas)
  		if (getparam('nbread') = 5) and work(zmanz) then
			ctes(zmanz) := zctes
			totctes := totctes + zctes
			vtas(zmanz) := zvtas
			totvtas := totvtas + zvtas
		end-if	
  	until (getparam('nbread') < 5)
  	fclose(F_INPUT)

	totctes := totctes / krutas
	totvtas := totvtas / krutas
	
	hctes := 10000000
	hzctes := 10000000
	hvtas := 10000000
	hzvtas := 10000000
	gctes := 0
	gzctes := 0
	gvtas := 0
	gzvtas := 0
	
	wzctes := 0
	wzvtas := 0
	wclust := 0
	wsigue := true
	zrest := 0
	wcteskern := 0.0
	wvtaskern := 0.0
	xmanz := 0
		
	! Roger: Dmax, MC1... MC50
  	fopen("MATRIX4.TXT",F_INPUT)
  	repeat
		readln(zclust,",",zmanz,",",zdist,",",zctes,",",zvtas,",",minclust)
		kwmanz(zmanz) := minclust
  		if (getparam('nbread') = 11 and work(zmanz)) then
	  		if zclust <> wclust then
  				if wctes/totctes <= hctes and wclust <> 0 then
  					hctes := wctes/totctes
 				end-if 	
  				if wvtas/totvtas <= hvtas and wclust <> 0 then
  					hvtas := wvtas/totvtas 
	 			end-if 					
  				if wctes/totctes >= gctes and wclust <> 0 then
  					gctes := wctes/totctes
 				end-if 					
  				if wvtas/totvtas >= gvtas and wclust <> 0 then
  					gvtas := wvtas/totvtas 
 				end-if 					

				if wctes/totctes <= 1.3 or wvtas/totvtas <= 1.3 then
					!**** Condición de ERROR ****
					writeln(wclust,":",wctes/totctes,",",wvtas/totvtas)	
				end-if	
				
  				if wzctes/totctes <= hzctes and wclust <> 0 then
  					hzctes := wzctes/totctes
 				end-if 					
  				if wzvtas/totvtas <= hzvtas and wclust <> 0 then
  					hzvtas := wzvtas/totvtas 
	 			end-if 					
  				if wzctes/totctes >= gzctes and wclust <> 0 then
  					gzctes := wzctes/totctes
 				end-if 					
  				if wzvtas/totvtas >= gzvtas and wclust <> 0 then
  					gzvtas := wzvtas/totvtas 
 				end-if 					
				
				wcteskern := wcteskern + wzctes / totctes
				wvtaskern := wvtaskern + wzvtas / totvtas				
  				wctes := 0
  				wzctes := 0
  				wvtas := 0
  				wzvtas := 0
				wclust := zclust
  				xmanz := zmanz
  				wsigue := true
  			end-if
			if ksqr then
				costo(zclust,zmanz) := (10*zdist)^2
			else
				costo(zclust,zmanz) := zdist				
			end-if

  			if costo(zclust,zmanz) <= zlimsup*wdbarra  and 
  				costo(zclust,zmanz) <= klimarc and 
  				(wctes+zctes<=totctes*kfactor or 
  					wvtas+zvtas<=totvtas*kfactor) and wsigue then
				wctes := wctes + zctes
				wvtas := wvtas + zvtas  				
				create(asigna(zclust,zmanz))
				asigna(zclust,zmanz) is_binary
					
		  		if allocmanz(zmanz) = 0 and zclust = minclust then
					if (wzctes+zctes <= zkern*totctes) and (wzvtas+zvtas<= zkern*totvtas) or zmanz = xmanz  then
						wzctes := wzctes + zctes
						wzvtas := wzvtas + zvtas
						zrest += 1
						allocmanz(zmanz):= zrest
						if zmanz <> xmanz then 
							wzrest(zrest) := asigna(zclust,zmanz) = asigna(zclust,xmanz)
							alloclust(zrest):= zclust
							kermanz(zmanz) := zclust
						else
							wzrest(zrest) := asigna(zclust,zmanz) = 1
							alloclust(zrest):= 999
							kermanz(zmanz) := zclust
							yclust(zclust):= zmanz
						end-if	
					end-if
		  		end-if
			else
				wsigue := false
			end-if
		end-if		
  	until (getparam('nbread') < 11 )
  	fclose(F_INPUT) 	

!*********************************************************************************** 	  	
  	fclose(F_OUTPUT)
	
	writeln("PROCESO DE CARGA TERMINADO...")
	writeln("% Min Cob Ctes = ",hctes)
	writeln("% Min Cob Vtas = ",hvtas)
	writeln("% Max Cob Ctes = ",gctes)
	writeln("% Max Cob Vtas = ",gvtas)
	writeln(" ")
	writeln("% Min Kernel Ctes = ",hzctes)
	writeln("% Min Kernel Vtas = ",hzvtas)
	writeln("% Max Kernel Ctes = ",gzctes)
	writeln("% Max Kernel Vtas = ",gzvtas)
	writeln("Kernel Sum % Ctes = ", wcteskern)
	writeln("Kernel Sum % Vtas = ", wvtaskern)	

	forall(j in manz | work(j)) do
		kc := 0
		forall(i in clust) do
			if costo(i,j)<>0 then
				kc := 1
				break
			end-if
		end-do
		if kc = 0 then
			writeln("Arco(+1),",kwmanz(j),",",j) 
			create(asigna(kwmanz(j),j))
			asigna(kwmanz(j),j) is_binary
			costo(kwmanz(j),j) := 0		
		end-if	
	end-do		


	forall(i in clust |yclust(i)=0 ) writeln(i)
!*********************************************************************************** 	
  	starttime := gettime  
  	finalize(clust)
  	finalize(manz)
			
!********************************************************************************
  	setparam("XPRS_PRESOLVE",1)            ! SIN = 0, CON = 1
  	setparam("XPRS_CUTSTRATEGY",3)         ! 1=CONSERV, 3= AGRESIVO
  	setparam("XPRS_MAXTIME",kmaxtime)      ! # DE SEGUNDOS POR MIP  	
	setparam("XPRS_MIPRELSTOP",mptol)      ! TOLERANCIA 
	setparam("XPRS_MIPTHREADS",8)      		! MIP THREADS

  	!setparam("XPRS_NODESELECTION",5)       ! DISABLE STRONG BRANCHING
  	!setparam("XPRS_HEURSTRATEGY",-1)       ! 2=Enhased, 3= Extensive, -1 = Automatic 
  	!setparam("XPRS_VARSELECTION",-1)       ! DISABLE STRONG BRANCHING
	!setparam("XPRS_HEURDIVESPEEDUP",1)  	

  	!setparam("XPRS_MAXMIPSOL",1)         ! # DE SOLUCIONES ENTERAS 
  	!setparam("XPRS_MIPPRESOLVE",6)        ! +1=Reduce Cost, +2=Logical Bin, +4=Probing Bin
  	!setparam("XPRS_MIPRELSTOP",ktol)       ! TOLERANCIA 
  	!setparam("XPRS_MIPLOG",0)             ! SIN LOG EN MIP
!********************************************************************************
	forall(j in manz | work(j)) 
		wmrest(j) := sum(i in clust) asigna(i,j) = 1    ! Cada Manzana en solo 1 Cluster

	forall(i in clust | actclust(i))
		sum(j in manz) asigna(i,j)*ctes(j) >= totctes*(1-kwtol)   ! Bal Ctes por Cluster

	forall(i in clust | actclust(i))
		sum(j in manz) asigna(i,j)*ctes(j) <= totctes*(1+kwtol)   ! Bal Ctes por Cluster

	forall(i in clust | actclust(i))
		sum(j in manz) asigna(i,j)*vtas(j) >= totvtas*(1-kwtol)   ! Bal Vtas por Cluster

	forall(i in clust | actclust(i))
		sum(j in manz) asigna(i,j)*vtas(j) <= totvtas*(1+kwtol)   ! Bal Vtas por Cluster
!********************************************************************************

	if kcuts1 then
		forall(j in manz, i in clust | exists(asigna(i,j))) 
			sum(k in manz | bounds(j,k))  
				asigna(i,k) >= asigna(i,j)
	end-if			

!********************************************************************************

	if kfobj = 0 then
		!forall(j in manz) hrstrai >= sum(i in clust) asigna(i,j)*costo(i,j)
		forall(i in clust, j in manz) hrstrai >= asigna(i,j)*costo(i,j)
	else	
		hrstrai = sum(i in clust, j in manz) asigna(i,j)*costo(i,j)
	end-if
	
   	asigobj := 0
!********************************************************************************  	
	kcic := 1
	repeat
	  	fobj := hrstrai + kpeso*asigobj*kpert
		minimize(kmotor,fobj)
		if getprobstat = XPRS_INF then
			while (true) do
				savebasis(mybasis)
				loadprob(true,fobj)
				loadbasis(mybasis)
				minimize(kmotor,fobj)					
				if getprobstat <> XPRS_INF then
					break
				end-if	
			end-do
		end-if	
					
		savebasis(mybasis)
		kborr := 0
		wmanz := 0
		asigobj:= 0
				
!***************************************************************************************
!*********************** FASE DE GENERACION DE CORTES 
!***************************************************************************************				
		
		xcont:= 0
		totmanz:= 0
		xdisconnect := 0 
		forall(j in manz) ypics(j) := false
		forall(hclust in clust) do
			hap1 := 0
			forall(ii in 1..200) zcompact(ii) := 0
			forall(j in manz) clon(j) := false

			hap1+=1								! Para el 1er elemento del cluster de revisión
			zcompact(hap1) := yclust(hclust) 	! Es el nucleo de cada cluster
			clon(yclust(hclust)) := true   
								
			while (true) do
				hap2 := -1
				kmove := false
				forall(j in manz | getsol(asigna(hclust,j)) = 1 and not(clon(j))) do  
					hap2 := 1
					while(hap2<=hap1) do
						if bounds(j,zcompact(hap2)) then
							hap1 +=1 
							hap2 := 0
							kmove := true
						end-if
						hap2 +=1
					end-do
				end-do
				if hap2 = -1 then
					break		! Se acabaron todas las manzanas y quedaron TODAS conectadas
				end-if	
			end-do	
					
			if hap2 >= 1 and not(kmove) then
!*******************************************************************************
				! Al menos existe 1 Manzana (Pick) NO contigua a Procesar en el Cluster
				xmanz := 0
				xdisconnect +=1
				forall(j in manz) gpics(j) := false
				forall(j in manz | getsol(asigna(hclust,j)) = 1 and not(clon(j))) do
					ypics(j) := true	! Es el TOTAL de las manzanas desconectadas, SOLO SE USA EN LA PERTURBACION
					gpics(j) := true   	! Es el TEMPORAL de las manzanas desconectadas
					xmanz += 1
				end-do
!*****************************************************************************
				! Se procesa cada uno de los Sub-picks: UNO X UNO
				while (true) do
					gap1 := 0
					forall(ii in 1..200) gcompact(ii) := 0
					forall(j in manz) gclon(j) := false
					
					while (true) do
						gap2 := -1
						gmove := false
						forall(j in manz | gpics(j) and not(gclon(j))) do
							! Se identifican las manzanas desconectadas que aún NO se PROCESAN
							if gap1 = 0 then
								gap1+=1
								gclon(j) := true	! Se agrega al SUB-PICK EN PROCESO
								gpics(j) := false 	! Se quita de las manzanas pendientes de PROCESAR
								gap2 := 1			! Se procesa al menos 1 elemento
							end-if
						end-do
						if gap2 = -1 then
							break 	! Ya NO quedó ninguna manzana DESCONECTADA pendiente de procesar
						end-if	
						if not(gmove) then
							break	! YA SE TIENE LISTO UN SIGUIENTE SUB-PICK, quedan manzanas PENDIENTES
						end-if
					end-do	
!*****************************************************************************
					xmanz := 0
					forall(j in manz) kpics(j) := false
					forall(j in manz) kbound(j) := false
					forall(j in manz | gclon(j)) do
						! Se procesa cada manzana del SUB-PICK incumbente
						xmanz += 1		! Es la cantidad de manzanas del SUB-PICK
						kpics(j) := true
						if allocmanz(j) <> 0 and alloclust(allocmanz(j)) <> 999 then 
							! Libera manzanas del Kernel
							! *** Revisar la cantidad de casos del tipo "999"
							allocmanz(j) := 0
							zrest -= 1
							kborr += 1
						end-if
					end-do
					jmanz := 0
					forall(j in manz | kpics(j))
						forall(k in manz | bounds(j,k) and not(kpics(k))) do 
							! Se determina el Conjunto de Manzanas que son Frontera del SUB-PICK
							kbound(k) := true
							jmanz +=1
						end-do	
					if jmanz >= 1 then
						! Agrega restricciòn al Cut Pool: Debe haber al menos 1 manzana de FRONTERA
						xcont += 1
						sum(j in manz | kbound(j) and exists(asigna(hclust,j))) (asigna(hclust,j)) -
								sum(j in manz | kpics(j)) (asigna(hclust,j)) >= 1 - xmanz
					else
						! *** Revisar cuantos casos hay de este tipo				
						writeln ("** ERROR:", hclust)
						forall(j in manz | kpics(j)) write(j , ",")
						writeln
						xmanz := 0	
					end-if
					hmanz := 0
					! Se contabiliza la cantidad de manzanas desconectadas que aún faltan de procesar
					forall(j in manz | gpics(j)) hmanz += 1
					if hmanz = 0 then
						! Si YA NO queda ninguna manzana desconectada por procesar, SE TERMINA
						break
					end-if
					! Itera para Buscar el Siguiente Sub-Pick
				end-do	
			end-if	
		end-do

		forall(j in manz, i in clust | getsol(asigna(i,j)) >= 0.99) 
			xclust(j) := i

		if totmanz >= kumbral then			
			asigobj:= - sum(j in manz | not(ypics(j)) and work(j)) 
						asigna(xclust(j),j)*costo(xclust(j),j) 
		else
			asigobj:= - sum(j in manz | not(ypics(j)) and work(j)) 
							asigna(xclust(j),j)	
		end-if	


		if kdin then
			kpeso := zpeso/maxlist(totmanz,1)
		end-if	

		karcmay := 0.0
		forall(i in clust, j in manz | getsol(asigna(i,j))>=0.1) do
			if costo(i,j) > karcmay then
				karcmay := 	costo(i,j)		
			end-if
		end-do	

		! ********* IMPRIME ITERACION
		writeln(getsol(fobj),",", getsol(hrstrai), ",", karcmay,",IT,",kcic,",R-,", kborr,",R+,", xcont, ",Manz,", totmanz ,",", xdisconnect ,",Kern,", zrest, ",TI,", gettime-starttime) 

		if totmanz = 0 then
			break
		end-if	
		if xcont = 0 then
			break
		end-if	
							
		loadprob(true,fobj)
		loadbasis(mybasis)
		kcic := kcic + 1	
	until false
!********************************************************************************

	! ********* IMPRIME SOLUCION	
	fopen("solfin.txt",F_OUTPUT)
	forall(i in clust, j in manz | getsol(asigna(i,j))>=0.1) do
		writeln(i, ",", j, ",", costo(i,j) , ",", ctes(j), ",", vtas(j)) 
	end-do	
  	fclose(F_OUTPUT)

end-model