Quadratic costing for integer division functions

plutus-benchmark/marlowe/test/semantics/9.6/004025fd712d6c325ffa12c16d157064192992faf62e0b991d7310a2f91666b8.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 708034699
+({cpu: 707938042
 | mem: 3255393})

plutus-benchmark/marlowe/test/semantics/9.6/04000f0b04051006000e060f09080d0b090d0104050a0b0f0506070f0a070008.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 655709980
+({cpu: 655613323
 | mem: 3084963})

plutus-benchmark/marlowe/test/semantics/9.6/119fbea4164e2bf21d2b53aa6c2c4e79414fe55e4096f5ce2e804735a7fbaf91.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 658927098
+({cpu: 658830441
 | mem: 3180611})

plutus-benchmark/marlowe/test/semantics/9.6/1d56060c3b271226064c672a282663643b1b0823471c67737f0b076870331260.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 686612699
+({cpu: 686516042
 | mem: 3082809})

plutus-benchmark/marlowe/test/semantics/9.6/70f65b21b77ddb451f3df9d9fb403ced3d10e1e953867cc4900cc25e5b9dec47.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 680927285
+({cpu: 680830628
 | mem: 3235511})

plutus-benchmark/marlowe/test/semantics/9.6/7a758e17486d1a30462c32a5d5309bd1e98322a9dcbe277c143ed3aede9d265f.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 428708655
+({cpu: 428611998
 | mem: 2003306})

plutus-benchmark/marlowe/test/semantics/9.6/a9a853b6d083551f4ed2995551af287880ef42aee239a2d9bc5314d127cce592.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 428708655
+({cpu: 428611998
 | mem: 2003306})

plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 1476440512
+({cpu: 1474894000
 | mem: 7526812})

plutus-benchmark/script-contexts/test/9.6/checkScriptContext1-20.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 287479352
+({cpu: 287382695
 | mem: 1064729})

plutus-benchmark/script-contexts/test/9.6/checkScriptContext1-4.budget.golden

@@ -1,2 +1,2 @@
-({cpu: 86252936
+({cpu: 86156279
 | mem: 330105})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/divideInteger/divideInteger-neg-neg/divideInteger-neg-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/divideInteger/divideInteger-neg-pos/divideInteger-neg-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/divideInteger/divideInteger-pos-neg/divideInteger-pos-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/divideInteger/divideInteger-pos-pos/divideInteger-pos-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/divideInteger/divideInteger1/divideInteger1.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/modInteger/modInteger-neg-neg/modInteger-neg-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/modInteger/modInteger-neg-pos/modInteger-neg-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/modInteger/modInteger-pos-neg/modInteger-pos-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/modInteger/modInteger-pos-pos/modInteger-pos-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/modInteger/modInteger1/modInteger1.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/quotientInteger/quotientInteger-neg-neg/quotientInteger-neg-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308809
+({cpu: 214466
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/quotientInteger/quotientInteger-neg-pos/quotientInteger-neg-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308809
+({cpu: 214466
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/quotientInteger/quotientInteger-pos-neg/quotientInteger-pos-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308809
+({cpu: 214466
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/quotientInteger/quotientInteger-pos-pos/quotientInteger-pos-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308809
+({cpu: 214466
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/quotientInteger/quotientInteger1/quotientInteger1.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/remainderInteger/remainderInteger-neg-neg/remainderInteger-neg-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/remainderInteger/remainderInteger-neg-pos/remainderInteger-neg-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/remainderInteger/remainderInteger-pos-neg/remainderInteger-pos-neg.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/remainderInteger/remainderInteger-pos-pos/remainderInteger-pos-pos.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/remainderInteger/remainderInteger1/remainderInteger1.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 308687
+({cpu: 212030
 | mem: 601})

plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs

@@ -289,13 +289,12 @@ readOneVariableFunConstOr e = do
   nonConstantPart <- readCF1AtType subtype e
   pure $ ModelConstantOrOneArgument constantPart nonConstantPart
 
--- | A costing function of the form a+sx.
 readOneVariableQuadraticFunction :: MonadR m => String -> SomeSEXP (Region m) -> m OneVariableQuadraticFunction
 readOneVariableQuadraticFunction var e = do
-  coeff0 <- Coefficient0 <$> getCoeff "(Intercept)" e
-  coeff1 <- Coefficient1 <$> getCoeff (printf "I(%s)" var) e
-  coeff2 <- Coefficient2 <$> getCoeff (printf "I(%s^2)" var) e
-  pure $ OneVariableQuadraticFunction coeff0 coeff1 coeff2
+  c0 <- Coefficient0 <$> getCoeff "(Intercept)" e
+  c1 <- Coefficient1 <$> getCoeff (printf "I(%s)" var) e
+  c2 <- Coefficient2 <$> getCoeff (printf "I(%s^2)" var) e
+  pure $ OneVariableQuadraticFunction c0 c1 c2
 
 readTwoVariableFunLinearOnDiagonal :: MonadR m => String -> SomeSEXP (Region m) -> m ModelConstantOrLinear
 readTwoVariableFunLinearOnDiagonal var e = do
@@ -312,6 +311,17 @@ readTwoVariableLinearFunction var1 var2 e = do
   slopeY <- Slope <$> getCoeff var2 e
   pure $ TwoVariableLinearFunction intercept slopeX slopeY
 
+readTwoVariableQuadraticFunction :: MonadR m => String -> String -> SomeSEXP (Region m) -> m TwoVariableQuadraticFunction
+readTwoVariableQuadraticFunction var1 var2 e = do
+  minVal <- getExtraParam "minimum" e
+  c00 <- Coefficient00 <$> getCoeff "(Intercept)" e
+  c10 <- Coefficient10 <$> getCoeff (printf "I(%s)" var1) e
+  c01 <- Coefficient01 <$> getCoeff (printf "I(%s)" var2) e
+  c20 <- Coefficient20 <$> getCoeff (printf "I(%s^2)" var1) e
+  c11 <- Coefficient11 <$> getCoeff (printf "I(%s * %s)" var1 var2) e
+  c02 <- Coefficient02 <$> getCoeff (printf "I(%s^2)" var2) e
+  pure $ TwoVariableQuadraticFunction minVal c00 c10 c01 c20 c11 c02
+
 -- | A two-variable costing function which is constant on one region of the
 -- plane and something else elsewhere.
 readTwoVariableFunConstOr :: MonadR m => SomeSEXP (Region m) -> m ModelConstantOrTwoArguments
@@ -361,6 +371,7 @@ readCF2AtType ty e = do
     "const_above_diagonal" -> ModelTwoArgumentsConstAboveDiagonal <$> readTwoVariableFunConstOr e
     "const_off_diagonal"   -> ModelTwoArgumentsConstOffDiagonal   <$> readOneVariableFunConstOr e
     "quadratic_in_y"       -> ModelTwoArgumentsQuadraticInY       <$> readOneVariableQuadraticFunction "y_mem" e
+    "quadratic_in_x_and_y" -> ModelTwoArgumentsQuadraticInXAndY   <$> readTwoVariableQuadraticFunction "x_mem" "y_mem" e
     _                      -> error $ "Unknown two-variable model type: " ++ ty
 
 readCF2 :: MonadR m => SomeSEXP (Region m) -> m ModelTwoArguments

plutus-core/cost-model/data/builtinCostModelC.json

@@ -360,10 +360,15 @@
                 "constant": 85848,
                 "model": {
                     "arguments": {
-                        "intercept": 228465,
-                        "slope": 122
+                        "c00": 123203,
+                        "c01": 7305,
+                        "c02": -900,
+                        "c10": 1716,
+                        "c11": 549,
+                        "c20": 57,
+                        "minimum": 85848
                     },
-                    "type": "multiplied_sizes"
+                    "type": "quadratic_in_x_and_y"
                 }
             },
             "type": "const_above_diagonal"
@@ -655,10 +660,15 @@
                 "constant": 85848,
                 "model": {
                     "arguments": {
-                        "intercept": 228465,
-                        "slope": 122
+                        "c00": 123203,
+                        "c01": 7305,
+                        "c02": -900,
+                        "c10": 1716,
+                        "c11": 549,
+                        "c20": 57,
+                        "minimum": 85848
                     },
-                    "type": "multiplied_sizes"
+                    "type": "quadratic_in_x_and_y"
                 }
             },
             "type": "const_above_diagonal"
@@ -703,10 +713,15 @@
                 "constant": 85848,
                 "model": {
                     "arguments": {
-                        "intercept": 228465,
-                        "slope": 122
+                        "c00": 123203,
+                        "c01": 7305,
+                        "c02": -900,
+                        "c10": 1716,
+                        "c11": 549,
+                        "c20": 57,
+                        "minimum": 85848
                     },
-                    "type": "multiplied_sizes"
+                    "type": "quadratic_in_x_and_y"
                 }
             },
             "type": "const_above_diagonal"
@@ -726,10 +741,15 @@
                 "constant": 85848,
                 "model": {
                     "arguments": {
-                        "intercept": 228465,
-                        "slope": 122
+                        "c00": 123203,
+                        "c01": 7305,
+                        "c02": -900,
+                        "c10": 1716,
+                        "c11": 549,
+                        "c20": 57,
+                        "minimum": 85848
                     },
-                    "type": "multiplied_sizes"
+                    "type": "quadratic_in_x_and_y"
                 }
             },
             "type": "const_above_diagonal"

plutus-core/cost-model/data/models.R

@@ -435,20 +435,24 @@ modelFun <- function(path) {
     ## a good fit.
     divideIntegerModel <- {
         fname <- "DivideInteger"
-        filtered <- data %>%  ## Data below diagonal
+
+        data1 <- data %>%  ## Data on or above diagonal: effectively constant time.
             filter.and.check.nonempty(fname) %>%
             filter(x_mem > 0 & y_mem > 0) %>%
-            filter (x_mem > y_mem) %>%
+            filter (x_mem <= y_mem) %>%
             discard.overhead ()
-        m <- lm(t ~ I(x_mem * y_mem), filtered)
+        constant = mean(data1$t)
 
-       filtered2 <- data %>%  ## Data on or above diagonal: effectively constant time.
+        data2 <- data %>%  ## Data below diagonal
             filter.and.check.nonempty(fname) %>%
             filter(x_mem > 0 & y_mem > 0) %>%
-            filter (x_mem <= y_mem) %>%
+            filter (x_mem > y_mem) %>%
             discard.overhead ()
-        constant = mean(filtered2$t)
-        mk.result(m, "const_above_diagonal", constant=constant, subtype="multiplied_sizes")
+        m <- lm(t ~ I(x_mem) + I(y_mem) + I(x_mem^2) + I(x_mem * y_mem) + I(y_mem^2), data2)
+
+        ## Re-use the above-diagonal cost as the minimum cost below the diagonal.  See Note
+        ## [Minimum values for two-variable quadratic costing functions].
+        mk.result(m, "const_above_diagonal", constant=constant, minimum=constant, subtype="quadratic_in_x_and_y")
     }
 
     quotientIntegerModel  <- divideIntegerModel
@@ -740,14 +744,11 @@ modelFun <- function(path) {
 
     ##### Models to be returned to Haskell #####
 
-    models <- list (
+    models.for.adjustment <-
+        list (
         addIntegerModel                      = addIntegerModel,
         subtractIntegerModel                 = subtractIntegerModel,
         multiplyIntegerModel                 = multiplyIntegerModel,
-        divideIntegerModel                   = divideIntegerModel,
-        quotientIntegerModel                 = quotientIntegerModel,
-        remainderIntegerModel                = remainderIntegerModel,
-        modIntegerModel                      = modIntegerModel,
         equalsIntegerModel                   = equalsIntegerModel,
         lessThanIntegerModel                 = lessThanIntegerModel,
         lessThanEqualsIntegerModel           = lessThanEqualsIntegerModel,
@@ -816,11 +817,20 @@ modelFun <- function(path) {
         bls12_381_finalVerifyModel           = bls12_381_finalVerifyModel,
         integerToByteStringModel             = integerToByteStringModel,
         byteStringToIntegerModel             = byteStringToIntegerModel
-    )
+        )
+
+    ## The integer division functions have a complex costing behaviour that requires some negative
+    ## coefficients to get accurate results. Because of this they are excluded from adjustModels:
+    ## the Haskell code receives the raw model and takes care of the (unlikely) case when a negative
+    ## value is returned itself (using a minimm value returned from R as an extra parameter).  Any
+    ## other builtins which need a non-monotonic costing function should be treated similarly.
 
-    return(adjustModels(models))
+    unadjusted.models <- list (
+        divideIntegerModel                   = divideIntegerModel,
+        quotientIntegerModel                 = quotientIntegerModel,
+        remainderIntegerModel                = remainderIntegerModel,
+        modIntegerModel                      = modIntegerModel
+    )
 
-    ## Caution!  If we introduce any non-monotonic costing functions they should
-    ## be excluded from adjustModels and make their own adjustments for eg,
-    ## possible negative return values
+    return(c(adjustModels(models.for.adjustment), unadjusted.models))
 }

plutus-core/cost-model/print-cost-model/Main.hs

@@ -37,10 +37,24 @@ renderLinearFunction (LinearFunction intercept slope) var =
               unparen v = if v /= "" && head v == '(' && last v == ')'
                           then tail $ init v
                           else v
-renderQuadraticFunction :: QuadraticFunction -> String -> String
-renderQuadraticFunction (QuadraticFunction c0 c1 c2) var =
+renderOneVariableQuadraticFunction
+  :: OneVariableQuadraticFunction
+  -> String
+  -> String
+renderOneVariableQuadraticFunction
+  (OneVariableQuadraticFunction c0 c1 c2) var =
     printf "%d + %d*%s + %d*%s^2" c0 c1 var c2 var
 
+renderTwoVariableQuadraticFunction
+  :: TwoVariableQuadraticFunction
+  -> String
+  -> String
+  -> String
+renderTwoVariableQuadraticFunction
+  (TwoVariableQuadraticFunction minVal c00 c10 c01 c20 c11 c02) var1 var2 =
+    printf "max(%d, %d + %d*%s + %d*%s + %d*%s^2 + %d*%s*%s + %d*%s^2)"
+    minVal c00 c10 var1 c01 var2 c20 var1 c11 var1 var2 c02 var2
+
 renderModel :: Model -> [String]
 renderModel =
     \case
@@ -52,8 +66,9 @@ renderModel =
      LinearInX             f   -> [ renderLinearFunction f "x" ]
      LinearInY             f   -> [ renderLinearFunction f "y" ]
      LinearInZ             f   -> [ renderLinearFunction f "z" ]
-     QuadraticInY          f   -> [ renderQuadraticFunction f "y" ]
-     QuadraticInZ          f   -> [ renderQuadraticFunction f "z" ]
+     QuadraticInY          f   -> [ renderOneVariableQuadraticFunction f "y" ]
+     QuadraticInZ          f   -> [ renderOneVariableQuadraticFunction f "z" ]
+     QuadraticInXAndY      f   -> [ renderTwoVariableQuadraticFunction f "x" "y" ]
      LiteralInYOrLinearInZ f -> [ "if y==0"
                                   , printf "then %s" $ renderLinearFunction f "z"
                                   , printf "else y bytes"

plutus-core/cost-model/test/TestCostModels.hs

@@ -44,6 +44,9 @@ import Hedgehog.Range qualified as Range
    for exact equality of the outputs but instead check that the R result and the
    Haskell result agreee to within a factor of 1/100 (one percent).
 -}
+-- FIXME: with this limit the two-variable quadratic costing functions for the
+-- integer division builtins fail to pass the test.  We don't run the test in
+-- CI, but we should still fix it.
 
 -- | Maximum allowable difference beween R result and Haskell result.
 epsilon :: Double