Skip to content

Commit

Permalink
Merge pull request #281 from zkFold/plonk-poly-mul
Browse files Browse the repository at this point in the history
feat: add polyMul in CoreFunction
  • Loading branch information
vlasin authored Oct 4, 2024
2 parents 873ecfe + 4f6eb02 commit e36b68a
Show file tree
Hide file tree
Showing 4 changed files with 39 additions and 29 deletions.
1 change: 1 addition & 0 deletions src/ZkFold/Base/Algebra/Polynomials/Univariate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module ZkFold.Base.Algebra.Polynomials.Univariate
, lt
, deg
, vec2poly
, poly2vec
, PolyVec
, fromPolyVec
, toPolyVec
Expand Down
9 changes: 6 additions & 3 deletions src/ZkFold/Base/Protocol/NonInteractiveProof/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,11 @@ import Data.Maybe (fromJust)
import qualified Data.Vector as V
import Data.Word (Word8)
import Numeric.Natural (Natural)
import Prelude hiding (sum)
import Prelude hiding (Num ((*)), sum)

import ZkFold.Base.Algebra.Basic.Class (sum)
import ZkFold.Base.Algebra.Basic.Class (Field, MultiplicativeSemigroup ((*)), sum)
import ZkFold.Base.Algebra.EllipticCurve.Class (EllipticCurve (..), Point)
import ZkFold.Base.Algebra.Polynomials.Univariate (PolyVec, fromPolyVec)
import ZkFold.Base.Algebra.Polynomials.Univariate (Poly, PolyVec, fromPolyVec)
import ZkFold.Base.Data.ByteString

class Monoid ts => ToTranscript ts a where
Expand Down Expand Up @@ -67,7 +67,10 @@ class NonInteractiveProof a core where
class (EllipticCurve curve) => CoreFunction curve core where
msm :: (f ~ ScalarField curve) => V.Vector (Point curve) -> PolyVec f size -> Point curve

polyMul :: (f ~ ScalarField curve, Field f, Eq f) => Poly f -> Poly f -> Poly f

data HaskellCore

instance (EllipticCurve curve, f ~ ScalarField curve) => CoreFunction curve HaskellCore where
msm gs f = sum $ V.zipWith mul (fromPolyVec f) gs
polyMul = (*)
23 changes: 13 additions & 10 deletions src/ZkFold/Base/Protocol/Plonk/Prover.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,9 @@ plonkProve PlonkupProverSetup {..}
(PlonkupWitnessInput wInput, PlonkupProverSecret ps)
= (PlonkupInput wPub, PlonkupProof {..}, PlonkupProverTestInfo {..})
where
(@) :: forall size . (KnownNat size) => PolyVec (ScalarField c1) size -> PolyVec (ScalarField c1) size -> PolyVec (ScalarField c1) size
(@) a b = poly2vec $ polyMul @c1 @core (vec2poly a) (vec2poly b)

PlonkupCircuitPolynomials {..} = polynomials
secret i = ps !! (i -! 1)

Expand All @@ -63,9 +66,9 @@ plonkProve PlonkupProverSetup {..}

-- Round 1

aX = polyVecLinear (secret 1) (secret 2) * zhX + w1X :: PlonkupPolyExtended n c1
bX = polyVecLinear (secret 3) (secret 4) * zhX + w2X :: PlonkupPolyExtended n c1
cX = polyVecLinear (secret 5) (secret 6) * zhX + w3X :: PlonkupPolyExtended n c1
aX = polyVecLinear (secret 1) (secret 2) @ zhX + w1X :: PlonkupPolyExtended n c1
bX = polyVecLinear (secret 3) (secret 4) @ zhX + w2X :: PlonkupPolyExtended n c1
cX = polyVecLinear (secret 5) (secret 6) @ zhX + w3X :: PlonkupPolyExtended n c1

com = msm @c1 @core @_ @(PlonkupPolyExtendedLength n)
cmA = gs `com` aX
Expand All @@ -83,14 +86,14 @@ plonkProve PlonkupProverSetup {..}
t_zeta = t relation
f_zeta = fromList $ zipWith3 (\lk ti ai -> bool ti ai (lk == one)) (toList $ qK relation) (toList $ t relation) (toList w1) :: PolyVec (ScalarField c1) n

fX = polyVecLinear (secret 7) (secret 8) * zhX + polyVecInLagrangeBasis omega f_zeta :: PlonkupPolyExtended n c1
fX = polyVecLinear (secret 7) (secret 8) @ zhX + polyVecInLagrangeBasis omega f_zeta :: PlonkupPolyExtended n c1

s = sortByList (toList f_zeta ++ toList t_zeta) (toList t_zeta)
h1 = toPolyVec $ V.ifilter (\i _ -> odd i) $ fromList s :: PolyVec (ScalarField c1) n
h2 = toPolyVec $ V.ifilter (\i _ -> even i) $ fromList s :: PolyVec (ScalarField c1) n

h1X = polyVecQuadratic (secret 9) (secret 10) (secret 11) * zhX + polyVecInLagrangeBasis omega h1 :: PlonkupPolyExtended n c1
h2X = polyVecLinear (secret 12) (secret 13) * zhX + polyVecInLagrangeBasis omega h2 :: PlonkupPolyExtended n c1
h1X = polyVecQuadratic (secret 9) (secret 10) (secret 11) @ zhX + polyVecInLagrangeBasis omega h1 :: PlonkupPolyExtended n c1
h2X = polyVecLinear (secret 12) (secret 13) @ zhX + polyVecInLagrangeBasis omega h2 :: PlonkupPolyExtended n c1

cmF = gs `com` fX
cmH1 = gs `com` h1X
Expand Down Expand Up @@ -154,10 +157,10 @@ plonkProve PlonkupProverSetup {..}
-- deltaX = scalePV delta one
-- epsilonX = scalePV epsilon one
qX = (
(qmX * aX * bX + qlX * aX + qrX * bX + qoX * cX + piX + qcX)
+ (aX + polyVecLinear beta gamma) * (bX + polyVecLinear (beta * k1) gamma) * (cX + polyVecLinear (beta * k2) gamma) * z1X .* alpha
- (aX + (beta *. s1X) + gammaX) * (bX + (beta *. s2X) + gammaX) * (cX + (beta *. s3X) + gammaX) * (z1X .*. omegas') .* alpha
+ (z1X - one) * polyVecLagrange @_ @n 1 omega .* alpha2
(qmX @ aX @ bX + qlX @ aX + qrX @ bX + qoX @ cX + piX + qcX)
+ (aX + polyVecLinear beta gamma) @ (bX + polyVecLinear (beta * k1) gamma) @ (cX + polyVecLinear (beta * k2) gamma) @ z1X .* alpha
- (aX + (beta *. s1X) + gammaX) @ (bX + (beta *. s2X) + gammaX) @ (cX + (beta *. s3X) + gammaX) @ (z1X .*. omegas') .* alpha
+ (z1X - one) @ polyVecLagrange @_ @n 1 omega .* alpha2
-- + qkX * (aX - fX) .* alpha3
-- + z2X * (one + deltaX) * (epsilonX + fX) * ((epsilonX * (one + deltaX)) + tX + deltaX * (tX .*. omegas')) .* alpha4
-- - (z2X .*. omegas') * ((epsilonX * (one + deltaX)) + h1X + deltaX * h2X) * ((epsilonX * (one + deltaX)) + h2X + deltaX * (h1X .*. omegas')) .* alpha4
Expand Down
35 changes: 19 additions & 16 deletions src/ZkFold/Base/Protocol/Plonkup/Prover.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,9 @@ plonkupProve PlonkupProverSetup {..}
(PlonkupWitnessInput wInput, PlonkupProverSecret ps)
= (PlonkupInput wPub, PlonkupProof {..}, PlonkupProverTestInfo {..})
where
(@) :: forall size . (KnownNat size) => PolyVec (ScalarField c1) size -> PolyVec (ScalarField c1) size -> PolyVec (ScalarField c1) size
(@) a b = poly2vec $ polyMul @c1 @core (vec2poly a) (vec2poly b)

PlonkupCircuitPolynomials {..} = polynomials
secret i = ps !! (i -! 1)

Expand All @@ -66,9 +69,9 @@ plonkupProve PlonkupProverSetup {..}

-- Round 1

aX = polyVecLinear (secret 1) (secret 2) * zhX + w1X :: PlonkupPolyExtended n c1
bX = polyVecLinear (secret 3) (secret 4) * zhX + w2X :: PlonkupPolyExtended n c1
cX = polyVecLinear (secret 5) (secret 6) * zhX + w3X :: PlonkupPolyExtended n c1
aX = polyVecLinear (secret 1) (secret 2) @ zhX + w1X :: PlonkupPolyExtended n c1
bX = polyVecLinear (secret 3) (secret 4) @ zhX + w2X :: PlonkupPolyExtended n c1
cX = polyVecLinear (secret 5) (secret 6) @ zhX + w3X :: PlonkupPolyExtended n c1

com = msm @c1 @core @_ @(PlonkupPolyExtendedLength n)
cmA = gs `com` aX
Expand All @@ -86,14 +89,14 @@ plonkupProve PlonkupProverSetup {..}
t_zeta = t relation
f_zeta = fromList $ zipWith3 (\lk ti ai -> bool ti ai (lk == one)) (toList $ qK relation) (toList $ t relation) (toList w1) :: PolyVec (ScalarField c1) n

fX = polyVecLinear (secret 7) (secret 8) * zhX + polyVecInLagrangeBasis omega f_zeta :: PlonkupPolyExtended n c1
fX = polyVecLinear (secret 7) (secret 8) @ zhX + polyVecInLagrangeBasis omega f_zeta :: PlonkupPolyExtended n c1

s = sortByList (toList f_zeta ++ toList t_zeta) (toList t_zeta)
h1 = toPolyVec $ V.ifilter (\i _ -> odd i) $ fromList s :: PolyVec (ScalarField c1) n
h2 = toPolyVec $ V.ifilter (\i _ -> even i) $ fromList s :: PolyVec (ScalarField c1) n

h1X = polyVecQuadratic (secret 9) (secret 10) (secret 11) * zhX + polyVecInLagrangeBasis omega h1 :: PlonkupPolyExtended n c1
h2X = polyVecLinear (secret 12) (secret 13) * zhX + polyVecInLagrangeBasis omega h2 :: PlonkupPolyExtended n c1
h1X = polyVecQuadratic (secret 9) (secret 10) (secret 11) @ zhX + polyVecInLagrangeBasis omega h1 :: PlonkupPolyExtended n c1
h2X = polyVecLinear (secret 12) (secret 13) @ zhX + polyVecInLagrangeBasis omega h2 :: PlonkupPolyExtended n c1

cmF = gs `com` fX
cmH1 = gs `com` h1X
Expand Down Expand Up @@ -130,14 +133,14 @@ plonkupProve PlonkupProverSetup {..}
./. (w1 + (beta *. sigma1s) .+ gamma)
./. (w2 + (beta *. sigma2s) .+ gamma)
./. (w3 + (beta *. sigma3s) .+ gamma)
z1X = polyVecQuadratic (secret 14) (secret 15) (secret 16) * zhX + polyVecInLagrangeBasis omega grandProduct1 :: PlonkupPolyExtended n c1
z1X = polyVecQuadratic (secret 14) (secret 15) (secret 16) @ zhX + polyVecInLagrangeBasis omega grandProduct1 :: PlonkupPolyExtended n c1

grandProduct2 = rotR . cumprod $
(one + delta) *. (epsilon +. f_zeta)
.*. ((epsilon * (one + delta)) +. t_zeta + delta *. rotL t_zeta)
./. ((epsilon * (one + delta)) +. h1 + delta *. h2)
./. ((epsilon * (one + delta)) +. h2 + delta *. rotL h1)
z2X = polyVecQuadratic (secret 17) (secret 18) (secret 19) * zhX + polyVecInLagrangeBasis omega grandProduct2 :: PlonkupPolyExtended n c1
z2X = polyVecQuadratic (secret 17) (secret 18) (secret 19) @ zhX + polyVecInLagrangeBasis omega grandProduct2 :: PlonkupPolyExtended n c1

cmZ1 = gs `com` z1X
cmZ2 = gs `com` z2X
Expand All @@ -157,14 +160,14 @@ plonkupProve PlonkupProverSetup {..}
deltaX = scalePV delta one
epsilonX = scalePV epsilon one
qX = (
(qmX * aX * bX + qlX * aX + qrX * bX + qoX * cX + piX + qcX)
+ (aX + polyVecLinear beta gamma) * (bX + polyVecLinear (beta * k1) gamma) * (cX + polyVecLinear (beta * k2) gamma) * z1X .* alpha
- (aX + (beta *. s1X) + gammaX) * (bX + (beta *. s2X) + gammaX) * (cX + (beta *. s3X) + gammaX) * (z1X .*. omegas') .* alpha
+ (z1X - one) * polyVecLagrange @_ @n 1 omega .* alpha2
+ qkX * (aX - fX) .* alpha3
+ z2X * (one + deltaX) * (epsilonX + fX) * ((epsilonX * (one + deltaX)) + tX + deltaX * (tX .*. omegas')) .* alpha4
- (z2X .*. omegas') * ((epsilonX * (one + deltaX)) + h1X + deltaX * h2X) * ((epsilonX * (one + deltaX)) + h2X + deltaX * (h1X .*. omegas')) .* alpha4
+ (z2X - one) * polyVecLagrange @_ @n 1 omega .* alpha5
(qmX @ aX @ bX + qlX @ aX + qrX @ bX + qoX @ cX + piX + qcX)
+ (aX + polyVecLinear beta gamma) @ (bX + polyVecLinear (beta * k1) gamma) @ (cX + polyVecLinear (beta * k2) gamma) @ z1X .* alpha
- (aX + (beta *. s1X) + gammaX) @ (bX + (beta *. s2X) + gammaX) @ (cX + (beta *. s3X) + gammaX) @ (z1X .*. omegas') .* alpha
+ (z1X - one) @ polyVecLagrange @_ @n 1 omega .* alpha2
+ qkX @ (aX - fX) .* alpha3
+ z2X @ (one + deltaX) @ (epsilonX + fX) @ ((epsilonX @ (one + deltaX)) + tX + deltaX @ (tX .*. omegas')) .* alpha4
- (z2X .*. omegas') @ ((epsilonX @ (one + deltaX)) + h1X + deltaX @ h2X) @ ((epsilonX @ (one + deltaX)) + h2X + deltaX @ (h1X .*. omegas')) .* alpha4
+ (z2X - one) @ polyVecLagrange @_ @n 1 omega .* alpha5
) `polyVecDiv` zhX
qlowX = toPolyVec $ V.take (fromIntegral (n+2)) $ fromPolyVec qX
qmidX = toPolyVec $ V.take (fromIntegral (n+2)) $ V.drop (fromIntegral (n+2)) $ fromPolyVec qX
Expand Down

0 comments on commit e36b68a

Please sign in to comment.