Use ValueOption instead of Option (#11)

This commit is contained in:
Patrick Stevens
2023-01-07 10:55:49 +00:00
committed by GitHub
parent 1009d7d468
commit a07ff8f852
16 changed files with 87 additions and 87 deletions

View File

@@ -64,7 +64,7 @@ module SampleImages =
2.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 400
@@ -87,7 +87,7 @@ module SampleImages =
InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.5<albedo>, Colour.White))
(Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
) // Floor rug
|]
|> Scene.make
@@ -104,7 +104,7 @@ module SampleImages =
2.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 400
@@ -127,7 +127,7 @@ module SampleImages =
InfinitePlane.make
(InfinitePlaneStyle.FuzzedReflection (1.0<albedo>, Colour.White, 0.75<fuzz>, random))
(Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
) // Floor rug
|]
|> Scene.make
@@ -146,7 +146,7 @@ module SampleImages =
7.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 200
@@ -215,7 +215,7 @@ module SampleImages =
InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.8<albedo>, Colour.White))
(Point.make 0.0 0.0 12.0)
(Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> Option.get)
(Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> ValueOption.get)
)
// Floor rug
@@ -232,7 +232,7 @@ module SampleImages =
random3
))
(Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
)
// Right side mirror
@@ -240,7 +240,7 @@ module SampleImages =
InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.95<albedo>, Colour.White))
(Point.make 0.0 0.0 12.0)
(Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> Option.get)
(Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> ValueOption.get)
)
// Light pad behind us
@@ -255,7 +255,7 @@ module SampleImages =
}
))
(Point.make 0.0 1.0 -1.0)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
)
|]
|> Scene.make
@@ -275,7 +275,7 @@ module SampleImages =
7.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 1200
@@ -402,7 +402,7 @@ module SampleImages =
}
))
(Point.make 0.0 0.0 -5.0)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
)
|]
|> Scene.make
@@ -421,7 +421,7 @@ module SampleImages =
1.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 300
@@ -514,7 +514,7 @@ module SampleImages =
1.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 200
@@ -607,7 +607,7 @@ module SampleImages =
1.0
aspectRatio
origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 200
@@ -721,7 +721,7 @@ module SampleImages =
origin
(Point.differenceToThenFrom (Point.make -1.0 0.0 1.0) origin
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 300
@@ -819,7 +819,7 @@ module SampleImages =
origin
(Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 800
@@ -969,7 +969,7 @@ module SampleImages =
origin
(Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
(Vector.make 0.0 1.0 0.0)
let pixels = 400

View File

@@ -21,7 +21,7 @@ module TestBoundingBox =
(Point.make ((if negate then (fun x -> -x) else id) delta) 0.0 0.0)
(Vector.make (if negate then -1.0 else 1.0) 0.0 0.0
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
let property
(x : NormalFloat)
@@ -50,7 +50,7 @@ module TestBoundingBox =
(Point.make 0.0 ((if negate then (fun x -> -x) else id) delta) 0.0)
(Vector.make 0.0 (if negate then -1.0 else 1.0) 0.0
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
let property
(x : NormalFloat)
@@ -74,7 +74,7 @@ module TestBoundingBox =
[<Test>]
let ``Bounding box forward, ray going backward, case 1`` () =
let ray =
Ray.make (Point.make 0.0 0.0 delta) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
Ray.make (Point.make 0.0 0.0 delta) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let z1, z2 = sort (-abs 0.0) (-abs 0.0)
let x1, x2 = sort 0.0 0.0
@@ -91,7 +91,7 @@ module TestBoundingBox =
(Point.make 0.0 0.0 ((if negate then (fun x -> -x) else id) delta))
(Vector.make 0.0 0.0 (if negate then -1.0 else 1.0)
|> Vector.unitise
|> Option.get)
|> ValueOption.get)
let property
(x : NormalFloat)
@@ -116,7 +116,7 @@ module TestBoundingBox =
[<Test>]
let ``Bounding box forward does intersect ray going forward`` () =
let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let box = BoundingBox.make (Point.make -1.0 -1.0 -1.0) (Point.make 1.0 1.0 1.0)

View File

@@ -10,7 +10,7 @@ module TestPlane =
[<Test>]
let ``Orthogonalise does make orthogonal vectors`` () =
let property (p : Plane) : bool =
let orth = Plane.orthonormalise p |> Option.get
let orth = Plane.orthonormalise p |> ValueOption.get
let v1, v2 = Plane.basis (Vector.make 0.0 1.0 0.0) orth
let dotVectors = UnitVector.dot (Ray.vector v1) (Ray.vector v2)
let v1Length = UnitVector.dot (Ray.vector v1) (Ray.vector v1)

View File

@@ -41,7 +41,7 @@ module TestSphere =
let rand = Random () |> FloatProducer
let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0
@@ -72,7 +72,7 @@ module TestSphere =
let rand = Random () |> FloatProducer
let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0
@@ -103,7 +103,7 @@ module TestSphere =
let rand = Random () |> FloatProducer
let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0

View File

@@ -38,7 +38,7 @@ module TestSphereIntersection =
Ray.make'
(Point.make 1.462205539 -4.888279676 7.123293244)
(Vector.make -9.549697616 4.400018428 10.41024923)
|> Option.get
|> ValueOption.get
let sphere =
Sphere.make

View File

@@ -37,7 +37,7 @@ module TestUtils =
vectorGen
|> Gen.filter (fun i -> Vector.normSquared i > 0.0)
|> Gen.map Vector.unitise
|> Gen.map Option.get
|> Gen.map ValueOption.get
let rayGen : Gen<Ray> =
gen {

View File

@@ -107,8 +107,8 @@ module BoundingBox =
(max (Point.coordinate 2 i.Max) (Point.coordinate 2 j.Max))
}
let merge (boxes : BoundingBox[]) : BoundingBox option =
let merge (boxes : BoundingBox[]) : BoundingBox voption =
if boxes.Length = 0 then
None
ValueNone
else
boxes |> Array.reduce mergeTwo |> Some
boxes |> Array.reduce mergeTwo |> ValueSome

View File

@@ -6,13 +6,13 @@ type BoundingBoxTree =
[<RequireQualifiedAccess>]
module BoundingBoxTree =
let make (boxes : (Hittable * BoundingBox) array) : BoundingBoxTree option =
let make (boxes : (Hittable * BoundingBox) array) : BoundingBoxTree voption =
if boxes.Length = 0 then
None
ValueNone
else
let rec go (boxes : (Hittable * BoundingBox) array) =
let boundAll = BoundingBox.merge (boxes |> Array.map snd) |> Option.get
let boundAll = BoundingBox.merge (boxes |> Array.map snd) |> ValueOption.get
if boxes.Length = 1 then
Leaf boxes.[0]
@@ -27,8 +27,8 @@ module BoundingBoxTree =
let boxes = boxes |> Array.sortBy (fun (_, b) -> Point.coordinate axis b.Min)
let leftHalf = boxes.[0 .. boxes.Length / 2]
let rightHalf = boxes.[(boxes.Length / 2) + 1 ..]
let leftBound = leftHalf |> Array.map snd |> BoundingBox.merge |> Option.get
let rightBound = rightHalf |> Array.map snd |> BoundingBox.merge |> Option.get
let leftBound = leftHalf |> Array.map snd |> BoundingBox.merge |> ValueOption.get
let rightBound = rightHalf |> Array.map snd |> BoundingBox.merge |> ValueOption.get
(leftHalf, leftBound), (rightHalf, rightBound)
)
@@ -40,4 +40,4 @@ module BoundingBoxTree =
Branch (go leftHalf, go rightHalf, boundAll)
go boxes |> Some
go boxes |> ValueSome

View File

@@ -11,11 +11,11 @@ type Hittable =
| UnboundedSphere s -> s.Reflection incoming strikePoint
| InfinitePlane p -> p.Reflection incoming strikePoint
member this.BoundingBox : BoundingBox option =
member this.BoundingBox : BoundingBox voption =
match this with
| Sphere s -> Sphere.boundingBox s |> Some
| Sphere s -> Sphere.boundingBox s |> ValueSome
| UnboundedSphere _
| InfinitePlane _ -> None
| InfinitePlane _ -> ValueNone
[<RequireQualifiedAccess>]
module Hittable =

View File

@@ -47,10 +47,10 @@ module InfinitePlane =
|> Plane.orthonormalise
match plane with
| None ->
| ValueNone ->
// Incoming ray is directly along the normal
Ray.flip incomingRay |> Ray.parallelTo strikePoint
| Some plane ->
| ValueSome plane ->
// Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2
// We want the reflection in the normal, so need (plane1.ray) plane1 - (plane2.ray) plane2
let normalComponent = -(UnitVector.dot plane.V1 (Ray.vector incomingRay))
@@ -63,7 +63,7 @@ module InfinitePlane =
Point.differenceToThenFrom s strikePoint
|> Ray.make' strikePoint
// This is definitely safe. It's actually a logic error if this fails.
|> Option.get
|> ValueOption.get
let newColour (incomingColour : Pixel) albedo colour =
Pixel.combine incomingColour colour |> Pixel.darken albedo
@@ -94,8 +94,8 @@ module InfinitePlane =
let output = Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match output with
| None -> ()
| Some output -> outgoing <- output
| ValueNone -> ()
| ValueSome output -> outgoing <- output
Continues
{
@@ -111,7 +111,7 @@ module InfinitePlane =
Point.differenceToThenFrom target strikePoint
|> Ray.make' strikePoint
|> Option.get
|> ValueOption.get
let newColour = Pixel.combine incomingRay.Colour colour |> Pixel.darken albedo

View File

@@ -26,8 +26,8 @@ module Plane =
else
Vector.make 1.0 1.0 ((-x - y) / z)
let v2 = Vector.cross v v1 |> Vector.unitise |> Option.get
let v1 = v1 |> Vector.unitise |> Option.get
let v2 = Vector.cross v v1 |> Vector.unitise |> ValueOption.get
let v1 = v1 |> Vector.unitise |> ValueOption.get
{
Point = point
@@ -37,7 +37,7 @@ module Plane =
let inline makeNormalTo' (point : Point) (UnitVector v) = makeNormalTo point v
let orthonormalise (plane : Plane) : OrthonormalPlane option =
let orthonormalise (plane : Plane) : OrthonormalPlane voption =
let coefficient = UnitVector.dot plane.V1 plane.V2
let vec2 =
@@ -45,14 +45,14 @@ module Plane =
|> Vector.unitise
match vec2 with
| None -> None
| Some v2 ->
| ValueNone -> ValueNone
| ValueSome v2 ->
{
V1 = plane.V1
V2 = v2
Point = plane.Point
}
|> Some
|> ValueSome
let makeSpannedBy (r1 : Ray) (r2 : Ray) : Plane =
{
@@ -63,18 +63,18 @@ module Plane =
/// Construct a basis for this plane, whose second ("up") component is `viewUp` when projected onto the plane.
let basis (viewUp : Vector) (plane : OrthonormalPlane) : Ray * Ray =
let viewUp = Vector.unitise viewUp |> Option.get
let viewUp = Vector.unitise viewUp |> ValueOption.get
let v1Component = UnitVector.dot plane.V1 viewUp
let v2Component = UnitVector.dot plane.V2 viewUp
let v2 =
Vector.sum (UnitVector.scale v1Component plane.V1) (UnitVector.scale v2Component plane.V2)
|> Vector.unitise
|> Option.get
|> ValueOption.get
let v1 =
Vector.sum (UnitVector.scale v2Component plane.V1) (UnitVector.scale (-v1Component) plane.V2)
|> Vector.unitise
|> Option.get
|> ValueOption.get
Ray.make plane.Point v1, Ray.make plane.Point v2

View File

@@ -25,14 +25,14 @@ module Vector =
let difference (Vector (a, b, c)) (Vector (x, y, z)) : Vector = Vector (a - x, b - y, c - z)
let unitise (vec : Vector) : UnitVector option =
let unitise (vec : Vector) : UnitVector voption =
let dot = dot vec vec
if Float.equal dot 0.0 then
None
ValueNone
else
let factor = 1.0 / sqrt dot
scale factor vec |> UnitVector |> Some
scale factor vec |> UnitVector |> ValueSome
let normSquared (vec : Vector) : float = dot vec vec
@@ -55,8 +55,8 @@ module UnitVector =
Vector.make x y z
|> Vector.unitise
|> function
| None -> random floatProducer dimension
| Some result -> result
| ValueNone -> random floatProducer dimension
| ValueSome result -> result
let inline dot (UnitVector a) (UnitVector b) = Vector.dot a b
let inline dot' (UnitVector a) (b : Vector) = Vector.dot a b

View File

@@ -8,15 +8,15 @@ type Ray =
[<RequireQualifiedAccess>]
module Ray =
let make' (origin : Point) (vector : Vector) : Ray option =
let make' (origin : Point) (vector : Vector) : Ray voption =
match Vector.unitise vector with
| None -> None
| Some v ->
| ValueNone -> ValueNone
| ValueSome v ->
{
Origin = origin
Vector = v
}
|> Some
|> ValueSome
let make (origin : Point) (vector : UnitVector) : Ray =
{

View File

@@ -10,7 +10,7 @@ type Ray =
[<RequireQualifiedAccess>]
module Ray =
val make' : Point -> Vector -> Ray option
val make' : Point -> Vector -> Ray voption
val make : Point -> UnitVector -> Ray
val walkAlong : Ray -> float -> Point

View File

@@ -6,7 +6,7 @@ type Scene =
private
{
UnboundedObjects : Hittable array
BoundingBoxes : BoundingBoxTree option
BoundingBoxes : BoundingBoxTree voption
}
[<RequireQualifiedAccess>]
@@ -16,9 +16,9 @@ module Scene =
let bounded, unbounded =
objects
|> Array.map (fun h -> h, Hittable.boundingBox h)
|> Array.partition (snd >> Option.isSome)
|> Array.partition (snd >> ValueOption.isSome)
let bounded = bounded |> Array.map (fun (h, box) -> h, Option.get box)
let bounded = bounded |> Array.map (fun (h, box) -> h, ValueOption.get box)
let unbounded = unbounded |> Array.map fst
let tree = bounded |> BoundingBoxTree.make
@@ -59,14 +59,14 @@ module Scene =
else
struct (bestFloat, bestObject, bestLength)
let hitObject (s : Scene) (ray : Ray) : (Hittable * Point) option =
let hitObject (s : Scene) (ray : Ray) : (Hittable * Point) voption =
let mutable best = Unchecked.defaultof<_>
let mutable bestLength = nan
let mutable bestFloat = infinity
match s.BoundingBoxes with
| None -> ()
| Some boundingBoxes ->
| ValueNone -> ()
| ValueSome boundingBoxes ->
let struct (f, o, l) =
bestCandidate (BoundingBox.inverseDirections ray) ray bestFloat best bestLength boundingBoxes
@@ -86,9 +86,9 @@ module Scene =
bestLength <- point
if Double.IsNaN bestLength then
None
ValueNone
else
Some (best, Ray.walkAlong ray bestLength)
ValueSome (best, Ray.walkAlong ray bestLength)
let internal traceRay (maxCount : int) (scene : Scene) (ray : LightRay) : Pixel =
let rec go (bounces : int) (ray : LightRay) : Pixel =
@@ -102,10 +102,10 @@ module Scene =
let thingsWeHit = hitObject scene ray.Ray
match thingsWeHit with
| None ->
| ValueNone ->
// Ray goes off into the distance and is never heard from again
Colour.Black
| Some (object, strikePoint) ->
| ValueSome (object, strikePoint) ->
let outgoingRay = object.Reflection ray strikePoint
match outgoingRay with
@@ -140,7 +140,7 @@ module Scene =
let ray =
Ray.make' (Ray.origin camera.View) (Point.differenceToThenFrom endPoint (Ray.origin camera.View))
|> Option.get
|> ValueOption.get
// Here we've hardcoded that the eye is emitting white light through a medium with refractance 1.
let result =

View File

@@ -76,7 +76,7 @@ module Sphere =
/// A ray hits the sphere with centre `centre` at point `p`.
/// This function gives the outward-pointing normal.
let normal (centre : Point) (p : Point) : Ray =
Ray.make' p (Point.differenceToThenFrom p centre) |> Option.get
Ray.make' p (Point.differenceToThenFrom p centre) |> ValueOption.get
let private liesOn' (centre : Point) (radius : float) (p : Point) : bool =
let rSquared = radius * radius
@@ -120,10 +120,10 @@ module Sphere =
let outgoing =
match plane with
| None ->
| ValueNone ->
// Incoming ray is directly along the normal
Ray.flip incomingLight.Ray |> Ray.parallelTo strikePoint
| Some plane ->
| ValueSome plane ->
// Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2
// We want the reflection in the normal, so need (plane1.ray) plane1 - (plane2.ray) plane2
let normalComponent = -UnitVector.dot plane.V1 (Ray.vector incomingLight.Ray)
@@ -137,7 +137,7 @@ module Sphere =
Point.differenceToThenFrom dest strikePoint
|> Ray.make' strikePoint
// This is safe: it's actually a logic error for this to fail.
|> Option.get
|> ValueOption.get
match fuzz with
| None -> outgoing
@@ -153,8 +153,8 @@ module Sphere =
Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match exitPoint with
| None -> ()
| Some o -> answer <- o
| ValueNone -> ()
| ValueSome o -> answer <- o
answer
@@ -163,10 +163,10 @@ module Sphere =
let plane = Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise
match plane with
| None ->
| ValueNone ->
// Incoming ray was parallel to normal; pass straight through
Ray.make strikePoint (Ray.vector incomingLight.Ray)
| Some plane ->
| ValueSome plane ->
let incomingSin = sqrt (1.0 - incomingCos * incomingCos)
let outgoingSin = incomingSin / index
@@ -186,7 +186,7 @@ module Sphere =
|> Ray.make' strikePoint
// This is safe: it's a logic error for this to fail. It would imply both the
// cos and the sin outgoing components were 0.
|> Option.get
|> ValueOption.get
match style with
| SphereStyle.LightSource texture ->
@@ -219,8 +219,8 @@ module Sphere =
Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match outputPoint with
| Some o -> answer <- o
| None -> ()
| ValueSome o -> answer <- o
| ValueNone -> ()
answer