patrick/ray-tracing-fsharp
1
0
Fork 0
mirror of https://github.com/Smaug123/ray-tracing-fsharp synced 2025-10-08 21:38:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

Perf (#2)

Browse Source
This commit is contained in:
Patrick Stevens
2021-04-07 18:53:51 +01:00
committed by GitHub
parent eefaa92d0e
commit a001bab92b
24 changed files with 458 additions and 753 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
RayTracing.Test/RayTracing.Test.fsproj
View File

@@ -8,7 +8,6 @@
<Compile Include="TestUtils.fs" />
<Compile Include="TestPpmOutput.fs" />
<Compile Include="TestRay.fs" />
<Compile Include="TestRational.fs" />
<Compile Include="TestSphereIntersection.fs" />
<EmbeddedResource Include="PpmOutputExample.txt" />
<Compile Include="TestPixel.fs" />

4
RayTracing.Test/TestPixel.fs
View File

@@ -13,7 +13,7 @@ module TestPixel =
let ``Average of one pixel`` () =
let property (p1 : byte) (p2 : byte) (p3 : byte) : bool =
let pixel = { Red = p1 ; Green = p2 ; Blue = p3 }
Pixel.average [ pixel ]
Pixel.average [| pixel |]
|> (=) pixel
Check.QuickThrowOnFailure property
@@ -78,7 +78,7 @@ module TestPixel =
values
|> List.map (fun (a, b, c) -> { Pixel.Red = a ; Green = b ; Blue = c })
let avg = Pixel.average pixels
let avg = Pixel.average (Array.ofList pixels)
avg.Green = (pixels |> List.map (fun i -> float i.Green) |> List.average |> Math.Round |> byte)
&& avg.Red = (pixels |> List.map (fun i -> float i.Red) |> List.average |> Math.Round |> byte)

10
RayTracing.Test/TestPlane.fs
View File

@@ -9,12 +9,12 @@ module TestPlane =
[<Test>]
let ``Orthogonalise does make orthogonal vectors`` () =
let property (p : Plane<float>) : bool =
let orth = Plane.orthonormalise Num.float p |> Option.get
let property (p : Plane) : bool =
let orth = Plane.orthonormalise p |> Option.get
let v1, v2 = Plane.basis orth
Num.float.Equal (Vector.dot Num.float v1.Vector v2.Vector) Num.float.Zero
&& Num.float.Equal (Vector.dot Num.float v1.Vector v1.Vector) Num.float.One
&& Num.float.Equal (Vector.dot Num.float v2.Vector v2.Vector) Num.float.One
Float.equal (UnitVector.dot (Ray.vector v1) (Ray.vector v2)) 0.0
&& Float.equal (UnitVector.dot (Ray.vector v1) (Ray.vector v1)) 1.0
&& Float.equal (UnitVector.dot (Ray.vector v2) (Ray.vector v2)) 1.0
property
|> Prop.forAll (Arb.fromGen TestUtils.planeGen)

34
RayTracing.Test/TestRational.fs
View File

@@ -1,34 +0,0 @@
namespace RayTracing.Test
open NUnit.Framework
open FsCheck
open RayTracing
[<TestFixture>]
module TestRational =
[<Test>]
let ``ofInt compares correctly`` () =
let property (i : int) (j : int) : bool =
let i1 = Rational.ofInt i
let j1 = Rational.ofInt j
if i1 < j1 then i < j
elif i1 > j1 then i > j
else i = j
Check.QuickThrowOnFailure property
[<Test>]
let ``Addition preserves comparison`` () =
let property (i : Rational, j : Rational, k : Rational) : bool =
if i < j then
Rational.add i k < Rational.add j k
elif i = j then
Rational.add i k = Rational.add j k
else
Rational.add i k > Rational.add j k
property
|> Prop.forAll (Arb.fromGen (Gen.three TestUtils.rationalGen))
|> Check.QuickThrowOnFailure

43
RayTracing.Test/TestRay.fs
View File

@@ -10,12 +10,11 @@ module TestRay =
[<Test>]
let ``Walking along two parallel rays maintains the same vector difference`` () =
let property
(num : Num<'a>)
(
((originX : 'a, originY : 'a, originZ : 'a),
(origin2X : 'a, origin2Y : 'a, origin2Z : 'a),
(rayX : 'a, rayY : 'a, rayZ : 'a)),
magnitude : 'a
(((originX : float, originY : float, originZ : float),
(origin2X : float, origin2Y : float, origin2Z : float)),
vector : UnitVector),
magnitude : float
)
: bool
=
@@ -24,40 +23,36 @@ module TestRay =
let origin2 =
[| origin2X; origin2Y; origin2Z |] |> Point
let vector = Vector [| rayX; rayY; rayZ |]
let ray = { Origin = origin1; Vector = vector }
let ray2 = { Origin = origin2; Vector = vector }
let output = Ray.walkAlong num ray magnitude
let output = Ray.walkAlong (Ray.make origin1 vector) magnitude
let output2 =
Ray.walkAlong num ray2 magnitude
let output2 = Ray.walkAlong (Ray.make origin2 vector) magnitude
let actual =
Point.difference num output output2
Point.difference output output2
let expected =
Point.difference num origin1 origin2
Point.difference origin1 origin2
Vector.equal num actual expected
Vector.equal actual expected
let gen : Gen<float> =
Arb.generate<NormalFloat>
|> Gen.map NormalFloat.op_Explicit
let gen =
Gen.zip (Gen.three (Gen.three gen)) gen
Gen.zip (Gen.zip (Gen.two (Gen.three gen)) TestUtils.unitVectorGen) gen
property Num.float
property
|> Prop.forAll (Arb.fromGen gen)
|> Check.QuickThrowOnFailure
[<Test>]
let ``walkAlong walks the right distance`` () =
let property (ray : Ray<float>, distance : float) =
let walked = Ray.walkAlong Num.float ray distance
Point.difference Num.float walked ray.Origin
|> Vector.normSquared Num.float
|> Num.float.Equal (distance * distance)
let property (ray : Ray, distance : float) =
let walked = Ray.walkAlong ray distance
Point.difference walked (Ray.origin ray)
|> Vector.normSquared
|> Float.equal (distance * distance)
property
|> Prop.forAll (Arb.fromGen (Gen.zip TestUtils.rayGen (Arb.generate<NormalFloat> |> Gen.map NormalFloat.op_Explicit)))
@@ -65,9 +60,9 @@ module TestRay =
[<Test>]
let ``walkAlong stays on the ray`` () =
let property (ray : Ray<float>, distance : float) =
let walked = Ray.walkAlong Num.float ray distance
Ray.liesOn Num.float walked ray
let property (ray : Ray, distance : float) =
let walked = Ray.walkAlong ray distance
Ray.liesOn walked ray
property
|> Prop.forAll (Arb.fromGen (Gen.zip TestUtils.rayGen (Arb.generate<NormalFloat> |> Gen.map NormalFloat.op_Explicit)))

18
RayTracing.Test/TestSphere.fs
View File

@@ -9,33 +9,31 @@ module TestSphere =
[<Test>]
let ``Point at distance r from centre lies on sphere`` () =
let property (centre : Point<float>, radius : float, point : Point<float>) : bool =
let property (centre : Point, radius : float, point : Point) : bool =
let radius = abs radius
let sphere = Sphere.make Num.float (SphereStyle.PureReflection (1.0, Colour.White)) centre radius
Sphere.liesOn Num.float point sphere
let sphere = Sphere.make (SphereStyle.PureReflection (1.0, Colour.White)) centre radius
Sphere.liesOn point sphere
let gen : Gen<Point<float> * float * Point<float>> =
let gen : Gen<Point * float * Point> =
gen {
let! centre = TestUtils.pointGen
let! radius = Arb.generate<NormalFloat> |> Gen.map NormalFloat.op_Explicit
let! theta =
Arb.generate<NormalFloat>
|> Gen.map NormalFloat.op_Explicit
|> Gen.map Radian
let! phi =
Arb.generate<NormalFloat>
|> Gen.map NormalFloat.op_Explicit
|> Gen.map Radian
let surfacePoint =
[|
radius * Num.float.Cos phi * Num.float.Sin theta
radius * Num.float.Sin phi * Num.float.Sin theta
radius * Num.float.Cos theta
radius * cos phi * sin theta
radius * sin phi * sin theta
radius * cos theta
|]
|> Point
|> Point.difference Num.float centre
|> Point.difference centre
|> fun (Vector v) -> Point v
return centre, radius, surfacePoint
}

34
RayTracing.Test/TestSphereIntersection.fs
View File

@@ -9,28 +9,28 @@ open RayTracing
module TestSphereIntersection =
let sphere : Gen<Sphere<float>> =
let sphere : Gen<Sphere> =
gen {
let! origin = TestUtils.pointGen
let! radius = Arb.generate<NormalFloat>
return Sphere.make Num.float (SphereStyle.LightSource Colour.White) origin radius.Get
return Sphere.make (SphereStyle.LightSource Colour.White) origin radius.Get
}
[<Test>]
let ``Intersection of sphere and ray does lie on both`` () =
let property (ray : Ray<float>, sphere : Sphere<float>) : bool =
let intersections = Sphere.intersections Num.float sphere ray Colour.White
let property (ray : Ray, sphere : Sphere) : bool =
let intersections = Sphere.intersections sphere ray Colour.White
intersections
|> Seq.forall (fun (p, _, _) ->
let rayOk = Ray.liesOn Num.float p ray
let sphereOk = Sphere.liesOn Num.float p sphere
let rayOk = Ray.liesOn p ray
let sphereOk = Sphere.liesOn p sphere
rayOk && sphereOk
)
&&
intersections
|> Array.map (fun (intersection, _, _) -> Vector.normSquared Num.float (Point.difference Num.float ray.Origin intersection))
|> Array.map (fun (intersection, _, _) -> Vector.normSquared (Point.difference (Ray.origin ray) intersection))
|> Seq.pairwise
|> Seq.forall (fun (i, j) -> Num.float.Compare i j = Less)
|> Seq.forall (fun (i, j) -> Float.compare i j = Less)
property
|> Prop.forAll (Arb.fromGen (Gen.zip TestUtils.rayGen sphere))
@@ -39,24 +39,22 @@ module TestSphereIntersection =
[<Test>]
let ``Intersection of sphere and ray does lie on both, case 1`` () =
let ray =
{
Origin = Point [|1.462205539; -4.888279676; 7.123293244|]
Vector = Vector [|-9.549697616; 4.400018428; 10.41024923|]
}
let sphere = Sphere.make Num.float (SphereStyle.PureReflection (1.0, Colour.White)) (Point [|-5.688391601; -5.360125644; 9.074300761|]) 8.199747973
Ray.make' (Point [|1.462205539; -4.888279676; 7.123293244|]) (Vector [|-9.549697616; 4.400018428; 10.41024923|])
|> Option.get
let sphere = Sphere.make (SphereStyle.PureReflection (1.0, Colour.White)) (Point [|-5.688391601; -5.360125644; 9.074300761|]) 8.199747973
let intersections = Sphere.intersections Num.float sphere ray Colour.White
let intersections = Sphere.intersections sphere ray Colour.White
intersections
|> Array.map (fun (intersection, _, _) -> Vector.normSquared Num.float (Point.difference Num.float ray.Origin intersection))
|> Array.map (fun (intersection, _, _) -> Vector.normSquared (Point.difference (Ray.origin ray) intersection))
|> Seq.pairwise
|> Seq.forall (fun (i, j) -> Num.float.Compare i j = Less)
|> Seq.forall (fun (i, j) -> Float.compare i j = Less)
|> shouldEqual true
intersections
|> Seq.forall (fun (p, _, _) -> Ray.liesOn Num.float p ray)
|> Seq.forall (fun (p, _, _) -> Ray.liesOn p ray)
|> shouldEqual true
intersections
|> Seq.forall (fun (p, _, _) -> Sphere.liesOn Num.float p sphere)
|> Seq.forall (fun (p, _, _) -> Sphere.liesOn p sphere)
|> shouldEqual true

40
RayTracing.Test/TestUtils.fs
View File

@@ -1,6 +1,5 @@
namespace RayTracing.Test
open System.Numerics
open RayTracing
open System.IO
open System.Reflection
@@ -29,27 +28,6 @@ module TestUtils =
use reader = new StreamReader (stream)
reader.ReadToEnd().Replace ("\r\n", "\n")
let rationalGen : Gen<Rational> =
gen {
let! i = Gen.choose (-100, 100)
let! sign = Gen.choose (0, 1)
let! j = Gen.choose (1, 100)
return Rational.Make (BigInteger i) (if sign = 0 then BigInteger j else BigInteger(-j))
}
let rec algebraicGen () : Gen<Algebraic> =
[
rationalGen |> Gen.map Algebraic.ofRational
Gen.two (algebraicGen ()) |> Gen.map Algebraic.Sum
Gen.two (algebraicGen ()) |> Gen.map Algebraic.Times
// TODO make this nonnegative
algebraicGen () |> Gen.map Algebraic.Sqrt
// TODO make this nonzero
algebraicGen () |> Gen.map Algebraic.Reciprocal
// TODO more of these
]
|> Gen.oneof
let floatGen = Arb.generate<NormalFloat> |> Gen.map NormalFloat.op_Explicit
let pointGen =
@@ -60,17 +38,23 @@ module TestUtils =
Gen.three Arb.generate<NormalFloat>
|> Gen.map (fun (i, j, k) -> Vector [| i.Get ; j.Get ; k.Get |])
let rayGen : Gen<Ray<float>> =
let unitVectorGen =
vectorGen
|> Gen.filter (fun i -> Vector.normSquared i > 0.0)
|> Gen.map Vector.unitise
|> Gen.map Option.get
let rayGen : Gen<Ray> =
gen {
let! origin = pointGen
let! direction = vectorGen
return { Origin = origin ; Vector = direction }
let! direction = unitVectorGen
return Ray.make origin direction
}
let planeGen =
gen {
let! origin = pointGen
let! v1 = vectorGen
let! v2 = vectorGen
return Plane.makeSpannedBy { Origin = origin ; Vector = v1 } { Origin = origin ; Vector = v2 }
let! v1 = unitVectorGen
let! v2 = unitVectorGen
return Plane.makeSpannedBy (Ray.make origin v1) (Ray.make origin v2)
}