Another lebensohl situation

src/Bids/Lebensohl.hs

@@ -9,15 +9,28 @@ module Bids.Lebensohl(
   , b1No2C2D
   , b1No2C2H
    -- Actual lebensohl bids
+  , b1No2C3D
+  , b1No2C3H
+  , b1No2C3S
   , b1No2D2H
   , b1No2D2S
+  , b1No2D3C
+  , b1No2D3H
+  , b1No2D3S
   , b1No2H2S
+  , b1No2H3C
+  , b1No2H3D
+  , b1No2H3S
+  , b1No2S3C
+  , b1No2S3D
+  , b1No2S3H
 ) where
 
 
 import Action(Action, withholdBid)
 import qualified Bids.OneNotrump as NT
-import EDSL(minSuitLength, makeCall, longerThan, pointRange)
+import EDSL(minSuitLength, makeCall, longerThan, atLeastAsLong, pointRange,
+            forbid, balancedHand, hasStopper, alternatives, soundHolding)
 import qualified Terminology as T
 
 
@@ -74,3 +87,75 @@ b1No2D2S = do
 
 b1No2H2S :: Action
 b1No2H2S = b1No2D2S
+
+
+primarySuit_ :: T.Suit -> Action
+primarySuit_ T.Clubs = do
+    T.Clubs `longerThan` T.Diamonds
+    T.Clubs `longerThan` T.Hearts
+    T.Clubs `longerThan` T.Spades
+primarySuit_ T.Diamonds = do
+    T.Diamonds `atLeastAsLong` T.Clubs
+    T.Diamonds `longerThan` T.Hearts
+    T.Diamonds `longerThan` T.Spades
+primarySuit_ T.Hearts = do
+    T.Hearts `atLeastAsLong` T.Clubs
+    T.Hearts `atLeastAsLong` T.Diamonds
+    T.Hearts `longerThan` T.Spades
+primarySuit_ T.Spades = do
+    T.Spades `atLeastAsLong` T.Clubs
+    T.Spades `atLeastAsLong` T.Diamonds
+    T.Spades `atLeastAsLong` T.Hearts
+primarySuit_ T.Notrump = error "notrump is not a primary suit"
+
+
+gfWithSuit_ :: T.Suit -> T.Suit -> Action
+gfWithSuit_ ourSuit oppsSuit = do
+    NT.gameForcing
+    minSuitLength ourSuit 5
+    primarySuit_ ourSuit
+    -- It's no fun when you bid a suit headed by the queen-nine. Probably do
+    -- that at the table, but practice the more obvious holdings instead.
+    soundHolding ourSuit
+    -- Prefer notrump when possible
+    alternatives [forbid balancedHand, forbid (hasStopper oppsSuit)]
+    makeCall $ T.Bid 3 ourSuit
+
+
+-- With 5-5 in two suits, bid the higher one, so you can rebid the lower one
+-- later.
+b1No2D3C :: Action
+b1No2D3C = gfWithSuit_ T.Clubs T.Diamonds
+
+b1No2H3C :: Action
+b1No2H3C = gfWithSuit_ T.Clubs T.Hearts
+
+b1No2S3C :: Action
+b1No2S3C = gfWithSuit_ T.Clubs T.Spades
+
+b1No2C3D :: Action
+b1No2C3D = gfWithSuit_ T.Diamonds T.Clubs
+
+b1No2H3D :: Action
+b1No2H3D = gfWithSuit_ T.Diamonds T.Hearts
+
+b1No2S3D :: Action
+b1No2S3D = gfWithSuit_ T.Diamonds T.Spades
+
+b1No2C3H :: Action
+b1No2C3H = gfWithSuit_ T.Hearts T.Clubs
+
+b1No2D3H :: Action
+b1No2D3H = gfWithSuit_ T.Hearts T.Diamonds
+
+b1No2S3H :: Action
+b1No2S3H = gfWithSuit_ T.Hearts T.Spades
+
+b1No2C3S :: Action
+b1No2C3S = gfWithSuit_ T.Spades T.Clubs
+
+b1No2D3S :: Action
+b1No2D3S = gfWithSuit_ T.Spades T.Diamonds
+
+b1No2H3S :: Action
+b1No2H3S = gfWithSuit_ T.Spades T.Hearts

src/EDSL.hs

@@ -15,6 +15,7 @@ module EDSL (
 , maxSuitLength
 , hasTopN
 , hasControl
+, hasStopper
 , soundHolding
 , longerThan
 , shorterThan
@@ -106,7 +107,13 @@ maxSuitLength :: T.Suit -> Int -> Action
 maxSuitLength = suitLengthOp "<=" "le"
 
 
+-- NOTE: this only works when the first argument is 5 or lower: dealer doesn't
+-- support checking "3 of the top 6" or similar, without redefining one of the
+-- alternate point counts specifically for it.
 hasTopN :: T.Suit -> Int -> Int -> Action
+hasTopN suit 1     minCount = do
+    constrain (join "_" [show suit, show minCount, "of", "top1"])
+              ["aces(", ", " ++ show suit ++ ") >= " ++ show minCount]
 hasTopN suit range minCount = do
     constrain (join "_" [show suit, show minCount, "of", "top", show range])
               ["top" ++ show range ++ "(", ", " ++ show suit ++
@@ -118,6 +125,18 @@ hasControl :: T.Suit -> Action
 hasControl suit = alternatives [hasTopN suit 2 1, maxSuitLength suit 1]
 
 
+-- TODO: Is Q10x a stopper? Maybe, maybe not. Similarly, is J10xx good enough,
+-- or should we really have J109x? If the latter, we'll need to redefine one of
+-- the alternate point counts or build something complicated with hasCard().
+hasStopper :: T.Suit -> Action
+hasStopper suit = alternatives [
+    hasTopN suit 1 1                          -- A
+  , hasTopN suit 2 1 >> minSuitLength suit 2  -- Kx
+  , hasTopN suit 4 2 >> minSuitLength suit 3  -- QJx
+  , hasTopN suit 5 3 >> minSuitLength suit 4  -- J10xx
+  ]
+
+
 -- A sound pre-empt has 2 of the top 3 or 3 of the top 5 cards in the suit.
 soundHolding :: T.Suit -> Action
 soundHolding suit = alternatives [hasTopN suit 3 2, hasTopN suit 5 3]

src/Topics/Lebensohl.hs

@@ -2,7 +2,7 @@ module Topics.Lebensohl(topic) where
 
 import qualified Bids.Cappelletti as Capp
 import qualified Bids.DONT as DONT
-import qualified Bids.Lebensohl as B
+import qualified Bids.Lebensohl as Leb
 import qualified Bids.Meckwell as MW
 import qualified Bids.NaturalOneNotrumpDefense as Nat
 import CommonBids(setOpener)
@@ -18,10 +18,10 @@ ignoreOpps = let
     sit (overcall, response, overcallIs2C) = let
         action = do
             setOpener T.North
-            B.b1N
+            Leb.b1N
             overcall
         explanation =
-            "Partner opened a strong " .+ B.b1N .+ ", and RHO interfered " .+
+            "Partner opened a strong " .+ Leb.b1N .+ ", and RHO interfered " .+
             "with the auction. However, their call didn't actually take up " .+
             "any of our bidding room. Ignore it, and use our usual systems " .+
             "over notrump" .+
@@ -30,27 +30,27 @@ ignoreOpps = let
       in situation "ignr" action response explanation
   in
     -- East should be an unpassed hand to interfere over North's notrump.
-    wrap $ return sit <~ [ (DONT.b1NoX,  B.b1NoX2C,  False)
-                         , (DONT.b1NoX,  B.b1NoX2D,  False)
-                         , (DONT.b1NoX,  B.b1NoX2H,  False)
-                         , (MW.b1NoX,    B.b1NoX2C,  False)
-                         , (MW.b1NoX,    B.b1NoX2D,  False)
-                         , (MW.b1NoX,    B.b1NoX2H,  False)
-                         , (Capp.b1NoX,  B.b1NoX2C,  False)
-                         , (Capp.b1NoX,  B.b1NoX2D,  False)
-                         , (Capp.b1NoX,  B.b1NoX2H,  False)
-                         , (DONT.b1No2C, B.b1No2CX,  True)
-                         , (DONT.b1No2C, B.b1No2C2D, True)
-                         , (DONT.b1No2C, B.b1No2C2H, True)
-                         , (MW.b1No2C,   B.b1No2CX,  True)
-                         , (MW.b1No2C,   B.b1No2C2D, True)
-                         , (MW.b1No2C,   B.b1No2C2H, True)
-                         , (Capp.b1No2C, B.b1No2CX,  True)
-                         , (Capp.b1No2C, B.b1No2C2D, True)
-                         , (Capp.b1No2C, B.b1No2C2H, True)
-                         , (Nat.b1No2C,  B.b1No2CX,  True)
-                         , (Nat.b1No2C,  B.b1No2C2D, True)
-                         , (Nat.b1No2C,  B.b1No2C2H, True)
+    wrap $ return sit <~ [ (DONT.b1NoX,  Leb.b1NoX2C,  False)
+                         , (DONT.b1NoX,  Leb.b1NoX2D,  False)
+                         , (DONT.b1NoX,  Leb.b1NoX2H,  False)
+                         , (MW.b1NoX,    Leb.b1NoX2C,  False)
+                         , (MW.b1NoX,    Leb.b1NoX2D,  False)
+                         , (MW.b1NoX,    Leb.b1NoX2H,  False)
+                         , (Capp.b1NoX,  Leb.b1NoX2C,  False)
+                         , (Capp.b1NoX,  Leb.b1NoX2D,  False)
+                         , (Capp.b1NoX,  Leb.b1NoX2H,  False)
+                         , (DONT.b1No2C, Leb.b1No2CX,  True)
+                         , (DONT.b1No2C, Leb.b1No2C2D, True)
+                         , (DONT.b1No2C, Leb.b1No2C2H, True)
+                         , (MW.b1No2C,   Leb.b1No2CX,  True)
+                         , (MW.b1No2C,   Leb.b1No2C2D, True)
+                         , (MW.b1No2C,   Leb.b1No2C2H, True)
+                         , (Capp.b1No2C, Leb.b1No2CX,  True)
+                         , (Capp.b1No2C, Leb.b1No2C2D, True)
+                         , (Capp.b1No2C, Leb.b1No2C2H, True)
+                         , (Nat.b1No2C,  Leb.b1No2CX,  True)
+                         , (Nat.b1No2C,  Leb.b1No2C2D, True)
+                         , (Nat.b1No2C,  Leb.b1No2C2H, True)
                          ]
                       <~ [T.North, T.South, T.West]
                       <~ T.allVulnerabilities
@@ -61,35 +61,73 @@ signoff = let
     sit (overcall, response) = let
         action = do
             setOpener T.North
-            B.b1N
+            Leb.b1N
             overcall
         explanation =
-            "Partner opened a strong " .+ B.b1N .+ ", and RHO interfered " .+
+            "Partner opened a strong " .+ Leb.b1N .+ ", and RHO interfered " .+
             "with the auction. We're so weak we don't even want to invite " .+
             "to game, but we do have enough strength to suspect this is " .+
             "our contract. Bid our suit at the 2 level, as signoff."
       in situation "snof" action response explanation
   in
-    wrap $ return sit <~ [ (DONT.b1No2D, B.b1No2D2H)
-                         , (DONT.b1No2D, B.b1No2D2S)
+    wrap $ return sit <~ [ (DONT.b1No2D, Leb.b1No2D2H)
+                         , (DONT.b1No2D, Leb.b1No2D2S)
                          -- If RHO shows both majors, don't bid a major!
-                         --, (DONT.b1No2H, B.b1No2H2S)
-                         , (MW.b1No2D,   B.b1No2D2H)
-                         , (MW.b1No2D,   B.b1No2D2S)
-                         , (MW.b1No2H,   B.b1No2H2S)
+                         --, (DONT.b1No2H, Leb.b1No2H2S)
+                         , (MW.b1No2D,   Leb.b1No2D2H)
+                         , (MW.b1No2D,   Leb.b1No2D2S)
+                         , (MW.b1No2H,   Leb.b1No2H2S)
                          -- If RHO shows both majors, don't bid a major!
-                         --, (Capp.b1No2D, B.b1No2D2H)
-                         --, (Capp.b1No2D, B.b1No2D2S)
-                         , (Capp.b1No2H, B.b1No2H2S)
-                         , (Nat.b1No2D,  B.b1No2D2H)
-                         , (Nat.b1No2D,  B.b1No2D2S)
-                         , (Nat.b1No2H,  B.b1No2H2S)
+                         --, (Capp.b1No2D, Leb.b1No2D2H)
+                         --, (Capp.b1No2D, Leb.b1No2D2S)
+                         , (Capp.b1No2H, Leb.b1No2H2S)
+                         , (Nat.b1No2D,  Leb.b1No2D2H)
+                         , (Nat.b1No2D,  Leb.b1No2D2S)
+                         , (Nat.b1No2H,  Leb.b1No2H2S)
                          ]
                       -- East should be an unpassed hand to interfere.
                       <~ [T.North, T.South, T.West]
                       <~ T.allVulnerabilities
 
 
+gameForce :: Situations
+gameForce = let
+    sit (overcall, responses) dlr vul = let
+        action = do
+            setOpener T.North
+            Leb.b1N
+            overcall
+        explanation =
+            "Partner opened a strong " .+ Leb.b1N .+ ", and RHO interfered " .+
+            "with the auction. We're at least game-forcing, so should " .+
+            "bid our suit at the 3 level. Partner will bid naturally, and " .+
+            "we'll find a game (likely either our suit or notrump)."
+        inner response = situation "gfnat" action response explanation dlr vul
+      in return inner <~ responses
+  in
+    wrap $ return sit
+        <~ [ (Nat.b1No2D,  [Leb.b1No2D3C, Leb.b1No2D3H, Leb.b1No2D3S])
+           , (Nat.b1No2H,  [Leb.b1No2H3C, Leb.b1No2H3D, Leb.b1No2H3S])
+           , (Nat.b1No2S,  [Leb.b1No2S3C, Leb.b1No2S3D, Leb.b1No2S3H])
+           , (DONT.b1No2D, [Leb.b1No2D3C, Leb.b1No2D3H, Leb.b1No2D3S])
+           -- Don't bid either major when the opponents have shown both
+           , (DONT.b1No2H, [Leb.b1No2H3C, Leb.b1No2H3D])
+           , (DONT.b1No2S, [Leb.b1No2S3C, Leb.b1No2S3D, Leb.b1No2S3H])
+           , (MW.b1No2D,   [Leb.b1No2D3C, Leb.b1No2D3H, Leb.b1No2D3S])
+           , (MW.b1No2H,   [Leb.b1No2H3C, Leb.b1No2H3D, Leb.b1No2H3S])
+           , (MW.b1No2S,   [Leb.b1No2S3C, Leb.b1No2S3D, Leb.b1No2S3H])
+           -- Again, don't bid a major when RHO has them both. 3D should be
+           -- natural and not a cue bid, because you'd never want to have a
+           -- Stayman-like bid when RHO has shown both majors.
+           , (Capp.b1No2D, [Leb.b1No2D3C, Leb.b1No2H3D])
+           , (Capp.b1No2H, [Leb.b1No2H3C, Leb.b1No2H3D, Leb.b1No2H3S])
+           , (Capp.b1No2S, [Leb.b1No2S3C, Leb.b1No2S3D, Leb.b1No2S3H])
+           ]
+        -- East should be an unpassed hand to interfere.
+        <~ [T.North, T.South, T.West]
+        <~ T.allVulnerabilities
+
+
 -- TODO:
 -- natural GF bids at the 3 level
 -- jump to 3N
@@ -108,4 +146,5 @@ topic = makeTopic
   where
     situations = wrap [ ignoreOpps
                       , signoff
+                      , gameForce
                       ]

src/Topics/StandardModernPrecision/TripleFourOne.hs

@@ -23,7 +23,7 @@ showAny4441 = let
           in
             situation "any" action' answer explanation dealer vul
       in
-        wrap $ return inner <~ dealers
+        return inner <~ dealers
   in
     wrap $ return sit <~ [ (do B.b1C
                                oppsPass
@@ -54,7 +54,7 @@ relay = let
           in
             situation "relay" action' answer explanation dealer vul
       in
-        wrap $ return inner <~ dealers
+        return inner <~ dealers
   in
     wrap $ return sit <~ [ (do B.b1C
                                oppsPass
@@ -92,7 +92,7 @@ bidSingleton = let
           in
             situation "bsing" action' answer explanation dealer vul
       in
-        wrap $ return inner <~ answers <~ dealers
+        return inner <~ answers <~ dealers
   in
     wrap $ return sit
         <~ [ (do B.b1C
@@ -142,7 +142,7 @@ singletonInPartnerSuit = let
           in
             situation "pdsing" action' ourBid explanation dealer vul
       in
-        wrap $ return inner <~ lastTwoBids <~ dealers
+        return inner <~ lastTwoBids <~ dealers
   in
     wrap $ return sit <~ [ (do B.b1C
                                oppsPass