.\deal.exe -i balancingx.tcl 1000 > results.txt

balancingx.tcl

source lib/score.tcl
# source lib/gib.tcl

source lib/parscore.tcl


holdingProc stopper {A K Q J T length} {
	if {$A && $length >= 2} { return true }
	if {$K && $length >= 2} { return true }
	if {$Q && $J && $length >= 3} { return true }
	if {$Q && $T && $length >= 3} { return true }
	if {$Q && $length >= 4} { return true }

	return false
}

patterncond anyflat { $l1 == 4 && $l2 == 3 && $l3 == 3 && $l4 == 3 }

south is T654 KJT7 K985 3

defvector aces 1

main {
	# Give west an opening hand with clubs
	if {[hcp west] <= 10 } { reject }
	if {[hcp west] >= 22 } { reject }
	if {[clubs west] <= 2 } { reject }
	
	# Assume no polish reverse
	if {[diamonds west] > [clubs west]} { reject } 
	if {[hearts west] > 5 && [hearts west] > [clubs west]} { reject }
	if {[spades west] > 5 && [spades west] > [clubs west]} { reject }
	if {[hcp west] >= 15 && [hcp west] < 17 && [semibalanced west]} { reject }
	if {[hcp west] >= 20 && [hcp west] < 21 && [semibalanced west]} { reject }

	# Give north a passed hand
	# No obvious overcall - 5 card major or diamonds an 9+ hcp
	if {[hcp north] >= 9 && [diamonds north] >= 5} { reject }
	if {[hcp north] >= 9 && [hearts north] >= 5} { reject }
	if {[hcp north] >= 9 && [spades north] >= 5} { reject }
	
	# No obvious notrump overcall (or X then NT)
	if {[hcp north] >= 15 && [semibalanced north] && [stopper north clubs]} {
		reject
	}
	
	# No obvious western cue bid
	if {[hcp north] >= 18 && [semibalanced north] && ![stopper north clubs]} {
		reject 
	}
	
	# No obvious double. TODO.
	if {[hcp north] >= 12 && [clubs north] <= 2 && ![anyflat north]} {
		if {([hearts north] == 4 || [spades north] == 4) && ([hearts north] >= 3 && [spades north] >= 3)} {
			reject
		}
	}
	
	# Give east a passed hand
	if {[hcp east] >= 6} { reject }
	
	 # Assume a weak 3C call is available
	if {[clubs east] >= 5 } { reject }
	
	# Assume a weak 2H/S call is available
	if {[hearts east] >= 6 } { reject } 
	if {[spades east] >= 6 } { reject }
	
	# Modern expert standard: assume no aces
	if {[aces east] >= 1} { reject }

	accept
}

proc par_upcase {word} {
    set first [string toupper [string range $word 0 0]]
    set rest [string range $word 1 end]
    append first $rest
}

proc defending_c_score {} {
	set trick_count [tricks west clubs]
	set newscore [score {1 clubs} vul $trick_count]
	set mult -1
	return [expr {$mult * $newscore}]
}

proc write_deal {} {
	set dealer west
	set vul All
	set par [parscore $dealer $vul]	
	set contract [lindex $par 0]
	set declarer [lindex $par 1]
	set score    [lindex $par 2]
	
	set clubscore [defending_c_score]
	
	puts "Contract: $contract by [par_upcase $declarer]"
	puts "N/S score: $score"
	puts "N/S score defending 1C: $clubscore"
	puts "Tuple: $score, $clubscore"
	puts ""
	puts -nonewline [format_deal]
}