capture program drop asignadipi
capture program drop checkinput
capture program drop _hiremainder
capture program drop listsort
capture program drop _checkclauses

*! asignadipi v1.0 JavierMarquez 22dic2009
program define asignadipi, rclass byable(recall) sortpreserve
	version 10.0	
	syntax namelist(min=2), PERCrp(numlist min=2) 		///
		[THReshold(real .02) MAXSeats(integer 300) 		///
		MAXOVERrep(real .08) NUMmay(numlist integer) 	///
		ESCrp(integer 200) MAXIter(integer 20)		 	///
		noPRInt]
	checkinput `0'	
	if ("`nummay'" == "") {
		local maxseats NA
		local maxoverrep NA
		local j = 0
		foreach var of local namelist {
			tempname ssd_`++j'
			scalar `ssd_`j'' = 0
		}
	}
	else {	
		local j = 0
		foreach var of local namelist {
			local tempo : word `++j' of `nummay'
			tempname ssd_`j'
			scalar `ssd_`j'' = `tempo'
		}
	}
	tempname _sizemay
	scalar `_sizemay' = 0
	local j = 0
	foreach var of local namelist {
		scalar `_sizemay' = `_sizemay' + `ssd_`++j''
	}
 	local j = 0
 	foreach var of local namelist {
		tempname vte_`++j' list_`j' 
	} 
	local j = 0
	foreach var of local namelist {
		local tempo : word `++j' of `percrp'
		scalar `vte_`j'' = `tempo'
	}
	tempname vne
	scalar `vne' = 0
	local j = 0
	foreach var of local namelist {
		if `vte_`++j'' >= `threshold' {
			scalar `vne' = `vne' + `vte_`j''
		}
	}
	foreach var of local namelist {
		local exc_list `exc_list' 0
	}	
	_hiremainder `namelist' `if' `in', vne(`=`vne'')	///
		seats(`escrp') thr(`threshold')					///
		percrp(`percrp') exc(`exc_list')
	local j = 0
	foreach var of local namelist {
		scalar `list_`++j'' = r(list_`j')
	}
	local iter = 0
	if ("`nummay'" != "") {
		local j = 0
		foreach var of local namelist {
			local MaxSeats_`++j' NO
			local MaxOverr_`j' NO
		}
		local j = 0
		local mylist1
		local mylist2
		foreach var of local namelist {
			local mylist1 `mylist1' `=`ssd_`++j'''
			local mylist2 `mylist2' `=`list_`j'''
		}	
		_checkclauses `namelist',						///
		_sizemay(`=`_sizemay'') escrp(`escrp')			///
			ssd(`mylist1') list(`mylist2') 				///
			vne(`=`vne'')								///
			maxseats(`maxseats') 						///
			maxoverrep(`maxoverrep')					///
			percrp(`percrp')
		tempname vnefec newescrp
		while "`r(clauses)'" == "YES" {	
			local iter = `iter' + 1	
			if `iter' >= `maxiter' {
				di as error "asignadip did not achieve " _c
				di as error "convergence because of " _c
				di as error "maxseats() and/or maxoverrep()"
				di as error "Max. number of iterations: `maxiter'"
				error 430
			} 
			local j = 0
			foreach var of local namelist {
				if `=`r(excMaxSeats_`++j')'' > 0 {
					local MaxSeats_`j' YES
				}
				if `=`r(excMaxOverr_`j')'' > 0 {
					local MaxOverr_`j' YES
				}
			}	
			scalar `vnefec' = 0 
			scalar `newescrp' = `escrp'
			local exc_list
			local j = 0
			foreach var of local namelist {
				scalar `list_`++j'' = 					///
					`list_`j'' - r(exc_`j')
				local exc_list  `exc_list' 				///
					`=`r(exc_`j')'' 
				if `vte_`j'' >= `threshold' & 			///
				`=`r(exc_`j')'' == 0 {
					scalar `vnefec' = `vnefec' + 		///
						`vte_`j''
				}
				if `=`r(exc_`j')'' > 0 {
					scalar `newescrp' =					///
						`newescrp' - `list_`j''	
				}
			}
			_hiremainder `namelist' ,					///
				vne(`=`vnefec'') seats(`=`newescrp'') 	///
				thr(`threshold') exc(`exc_list')		///
				percrp(`percrp')
			local j = 0	
			foreach var of local namelist {
				if "`=r(list_`++j')'" != "." {
					scalar `list_`j'' = 				///
						r(list_`j')
				}
			}		
			local j = 0
			local mylist1
			local mylist2
			foreach var of local namelist {
				local mylist1 `mylist1' `=`ssd_`++j'''
				local mylist2 `mylist2' `=`list_`j'''
			}
			_checkclauses `namelist' `if' `in',			///
				_sizemay(`=`_sizemay'') escrp(`escrp')	///
				ssd(`mylist1') list(`mylist2') 			///
				vne(`=`vne'')							///
				maxseats(`maxseats') 					///
				maxoverrep(`maxoverrep')				///
				percrp(`percrp')		
			local j = 0
			foreach var of local namelist {
				if `=`r(excMaxSeats_`++j')'' > 0 {
					local MaxSeats_`j' YES
				}
				if `=`r(excMaxOverr_`j')'' > 0 {
					local MaxOverr_`j' YES
				}
			}
		}
	}
	tempname _sizerp
	scalar `_sizerp' = 0
	local j = 0
	foreach var of local namelist {
		scalar `_sizerp' = `_sizerp' + `list_`++j''
	}
	local j = 0
	foreach var of local namelist {
		local ssd `ssd' `=`ssd_`++j'''
		return scalar ssd_`j' = `ssd_`j''
		return scalar list_`j' = `list_`j''
		return local MaxSeats_`j' `MaxSeats_`j''
		return local MaxOverr_`j' `MaxOverr_`j''
	}
	return local ssd `ssd'
	local j = 0
	foreach var of local namelist {
		tempname tot_`++j'
		scalar `tot_`j'' = `ssd_`j'' + `list_`j''
	}
	tempname chamber_size
	scalar `chamber_size' = `_sizemay' + `_sizerp'
	if ("`print'" != "noprint") {
		.tableasignadip = ._tab.new
		.tableasignadip.reset, columns(8) lmargin(0)
		.tableasignadip.width 		12| 	. 	. 	. 	. 		. 		. 	.
		.tableasignadip.titlefmt 	%12s 	. 	. 	. 	. 		. 		. 	.
		.tableasignadip.strfmt 		%12s 	. 	. 	. 	. 		. 		.	.
		.tableasignadip.numfmt		. 		. 	. 	. 	%10.2f	%10.2f	. 	.
		.tableasignadip.pad 		. 		. 	. 	. 	. 		. 		. 	.
		.tableasignadip.titlecolor 	. 		. 	. 	. 	. 		. 		. 	.
		.tableasignadip.strcolor 	.	 	. 	. 	. 	. 		. 		. 	.
		.tableasignadip.numcolor 	. 		. 	. 	. 	. 		. 		. 	.
		local w = `.tableasignadip.width_of_table'
		local lengthmaxoverrep : length local maxoverrep
		local w = `w'-32-`lengthmaxoverrep'
		di
		di as text "Single-Member Seats{col 26}=" 		as result %8.0g `_sizemay'
		di as text "List Seats{col 26}=" 			as result %8.0g `_sizerp'
		di as text "Chamber Size{col 26}=" 			as result %8.0g `chamber_size'
		di as text "Threshold{col 26}="				as result %8s "`threshold'"
		di as text "Max. number of seats{col 26}="		as result %8s "`maxseats'"
		di as text "Max. overrepresentation{col 26}="		as result %8s "`maxoverrep'" _c
		di as text "{ralign `w':Number of iterations = {result}`iter'}"
		di
		.tableasignadip.sep, top
		.tableasignadip.titles "Party " "SSD seats" "List seats" "Total" "%Votes" "%Seats" "MaxSeats" "MaxOverrep"
		.tableasignadip.sep, middle
		local j = 0
		foreach var of local namelist {
			local abname_`var' = abbrev("`var'",11)
			tempname percent_votes_`++j' percent_seats_`j'
			scalar `percent_votes_`j'' = `vte_`j''*100
			scalar `percent_seats_`j'' = (`tot_`j''/`chamber_size')*100
			.tableasignadip.row 				///
						"`abname_`var'' "		///1
						`ssd_`j'' 				///2
						`list_`j'' 				///3
						`tot_`j'' 				///4
						`percent_votes_`j'' 	///5
						`percent_seats_`j''		///6
						"`MaxSeats_`j''" 		///7
						"`MaxOverr_`j''"
		}
		.tableasignadip.sep, bottom
	}
end

*! checkinput v1.0 JavierMarquez 22dic2009
program define checkinput, byable(recall) sortpreserve
	version 10.0
	syntax namelist(min=2), PERCrp(numlist min=2) 		///
		[THReshold(real .02) MAXSeats(integer 300) 		///
		MAXOVERrep(real .08) NUMmay(numlist integer) 	///
		ESCrp(integer 200) MAXIter(integer 20)		 	///
		noPRInt]
	local tempo = 0
	foreach perc of local percrp {
		local tempo = `tempo' + `perc'
	}
	if `tempo' < 0 | `tempo' > 1 {
		di as err "Values in percrp() are invalid. " _c
		error 198
	}		
	local tempo threshold maxoverrep
	foreach t of local tempo {
		if ``t'' < 0 | ``t'' > 1 {
			di as err "Values in `t'() are invalid. " _c
			di as err "Values must be between 0 and 1"
			error 198
		}
	}
	local tempo maxseats escrp maxiter
	foreach t of local tempo {
		if ``t'' < 0 {
			di as err "Values in `t'() are invalid. " _c
			di as err "Values must be > 1"
			error 198
		}
	}	
	local tempo1: word count `namelist'
	local tempo2: word count `nummay'
	local tempo3: word count `percrp'
	if "`nummay'" == "" {
		if `tempo1' != `tempo3' {
			di as err "invalid numlist in option percrp()"
			error 198
		}
	}
	else {
		if `tempo1' != `tempo2' | `tempo1' != `tempo3' {
			di as err "invalid numlist in options " _c
			di as err "nummay() and/or percrp"
			error 198
		}
	}
end

*! _hiremainder v1.0 JavierMarquez 22dic2009
program define _hiremainder, rclass byable(recall) sortpreserve
	version 10.0
	syntax namelist(min=2) ,							///
		vne(real) seats(integer) THReshold(real) 		///
		percrp(numlist min=2) exc(numlist min=2)
	local j = 0
	foreach var of local namelist {
		local tempo : word `++j' of `percrp'
		tempname vte_`j'
		scalar `vte_`j'' = `tempo'
	}
	tempname cociente
	scalar `cociente' = `vne'/`seats'
	local j = 0
	foreach var of local namelist {
		tempname entero_`++j' residuo_`j'
		scalar `entero_`j'' = 0
		scalar `residuo_`j'' = 0
		local tempo: word `j' of `exc'
		if `vte_`j'' >= `threshold' & `tempo' == 0 {
			scalar `entero_`j'' = 						///
				int(`vte_`j''/`cociente')
			scalar `residuo_`j'' = 						///
				mod(`vte_`j'',`cociente')
		}
	}
	local j = 0		
	foreach var of local namelist {	
		local listresiduos `listresiduos' `=`residuo_`++j'''
	}
	listsort "`listresiduos'", reverse	
	local i = 0		
	foreach var of local namelist {
		local orden_`++i' = s(i`i')
	}
	tempname sobrantes 
	scalar `sobrantes' = `seats'
	local j = 0
	foreach var of local namelist {
		scalar `sobrantes' = `sobrantes' - `entero_`++j'' 
	}
	local j = 0	
	foreach var of local namelist {			
		tempname resto_`++j'
		scalar `resto_`j'' = 0
		if `sobrantes' > 0 {
			forvalues i = 1/`=`sobrantes'' {
				if `=`residuo_`j''' == `orden_`i'' {
					scalar `resto_`j'' = 1
				}
			}
		}
	}
	local j = 0	
	foreach var of local namelist {
		local tempo: word `++j' of `exc'
		if `tempo' == 0 {
		return scalar list_`j' = 						///
			`entero_`j'' + `resto_`j''
		}
	}
end

*! listsort version 1.0.0 PR 16Feb2001.  (TSJ-1: dm0001)
program define listsort, sclass
	version 6
	gettoken p 0 : 0, parse(" ,")
	if `"`p'"'=="" {
	        exit
	}
	sret clear
	syntax , [ Reverse Lexicographic ]
	local lex="`lexicog'"!=""
	if "`reverse'"!="" { local comp < }
	else local comp >
	local np: word count `p'
	local i 1
	while `i'<=`np' {
	        local p`i': word `i' of `p'
	        if !`lex' { confirm number `p`i'' }
	        local i=`i'+1
	}
	* Apply shell sort (Kernighan & Ritchie p 58)
	local gap=int(`np'/2)
	while `gap'>0 {
	        local i `gap'
	        while `i'<`np' {
	                local j=`i'-`gap'
	                while `j'>=0 {
	                        local j1=`j'+1
	                        local j2=`j'+`gap'+1
	                        if `lex' { local swap=(`"`p`j1''"' `comp' `"`p`j2''"') }
	                        else local swap=(`p`j1'' `comp' `p`j2'')
	                        if `swap' {
	                                local temp `p`j1''
	                                local p`j1' `p`j2''
	                                local p`j2' `temp'
	                        }
	                        local j=`j'-`gap'
	                }
	                local i=`i'+1
	        }
	        local gap=int(`gap'/2)
	}
	local p
	local i 1
	while `i'<=`np' {
	        sret local i`i' `p`i''
	        local p `p' `p`i''
	        local i=`i'+1
	}
	sret local list `p'
end

*! _checkclauses v1.0 JavierMarquez 22dic2009
program define _checkclauses, rclass
	syntax namelist(min=2) ,							///
		_sizemay(integer) escrp(integer)				///
		ssd(numlist) list(numlist) vne(real)			///
		maxseats(integer) maxoverrep(real) 				///
		percrp(numlist min=2)
	local j = 0
	foreach var of local namelist {
		local tempo : word `++j' of `percrp'
		tempname vte_`j'
		scalar `vte_`j'' = `tempo'
	}
	tempname chamber_size
	scalar `chamber_size' = `_sizemay' + `escrp'
	local clauses = "NO"
	local j = 0
	foreach var of local namelist {
		tempname tot_`++j' excMaxSeats_`j' excMaxOverr_`j'
		local ssd_`j': word `j' of `ssd'
		local list_`j' : word `j' of `list'
		scalar `tot_`j'' = `ssd_`j'' + `list_`j''
		scalar `excMaxSeats_`j'' = 0
		scalar `excMaxOverr_`j'' = 0
		if `tot_`j'' > `maxseats' {
			local clauses = "YES"
			scalar `excMaxSeats_`j'' = 					///
				`tot_`j'' - `maxseats'
		}
		if ((`tot_`j''/`chamber_size') >				///
			((`vte_`j''/`vne') + `maxoverrep')			///
		&  ( `ssd_`j''/`chamber_size') <				/// 
			((`vte_`j''/`vne') + `maxoverrep')) {
				local clauses = "YES"
				scalar `excMaxOverr_`j'' = 				///
				`tot_`j'' - int(((`vte_`j''/`vne') +	///
				`maxoverrep')*`chamber_size')
		}
		return scalar excMaxSeats_`j' = 				///
			`excMaxSeats_`j''
		return scalar excMaxOverr_`j' = 				///
			`excMaxOverr_`j''
		return scalar exc_`j' = 						///
			max(`=`excMaxSeats_`j''', 					///
			`=`excMaxOverr_`j''')
	}
	return local clauses `clauses'
end