Skip to content

Commit c45bdfa

Browse files
gsvgitgsvgit
committed
Optimized GPU version
1 parent 998f371 commit c45bdfa

File tree

3 files changed

+73
-38
lines changed

3 files changed

+73
-38
lines changed

‎src/ImageProcessing/ImageProcessing.fs‎

Lines changed: 34 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,24 @@
11
module ImageProcessing.ImageProcessing
22

3+
open System
34
open Brahma.FSharp
45
open SixLabors.ImageSharp
56
open SixLabors.ImageSharp.PixelFormats
67

8+
[<Struct>]
9+
type Image =
10+
val Data: array<byte>
11+
val Width: int
12+
val Height: int
13+
val Name: string
14+
new (data, width, height, name) =
15+
{
16+
Data= data
17+
Width = width
18+
Height = height
19+
Name = name
20+
}
21+
722
let loadAs2DArray (file:string) =
823
let img = Image.Load<L8> file
924
let res = Array2D.zeroCreate img.Height img.Width
@@ -13,6 +28,12 @@ let loadAs2DArray (file:string) =
1328
printfn $"H=%A{img.Height} W=%A{img.Width}"
1429
res
1530

31+
let loadAsImage (file:string) =
32+
let img = Image.Load<L8> file
33+
let buf = Array.zeroCreate<byte> (img.Width*img.Height)
34+
img.CopyPixelDataTo (Span<byte> buf)
35+
Image(buf, img.Width, img.Height, System.IO.Path.GetFileName file)
36+
1637
let save2DByteArrayAsImage (imageData: byte[,]) file =
1738
let h = imageData.GetLength 0
1839
let w = imageData.GetLength 1
@@ -25,6 +46,10 @@ let save2DByteArrayAsImage (imageData: byte[,]) file =
2546
let img = Image.LoadPixelData<L8>(flat2Darray imageData,w,h)
2647
img.Save file
2748

49+
let saveImage (image:Image) file =
50+
let img = Image.LoadPixelData<L8>(image.Data,image.Width,image.Height)
51+
img.Save file
52+
2853
let gaussianBlurKernel =
2954
[|
3055
[| 1; 4; 6; 4; 1|]
@@ -103,32 +128,22 @@ let applyFilterGPUKernel (clContext: ClContext) localWorkSize =
103128
let applyFiltersGPU (clContext: ClContext) localWorkSize =
104129
let kernel = applyFilterGPUKernel clContext localWorkSize
105130
let queue = clContext.QueueProvider.CreateQueue()
106-
fun (filters: list<float32[][]>) (img: byte[,]) ->
107-
let imgH = img.GetLength 0
108-
let imgW = img.GetLength 1
109-
let img =
110-
[| for x in 0 .. Array2D.length1 img - 1 do
111-
yield! [| for y in 0 .. Array2D.length2 img - 1 -> img.[x, y] |]
112-
|]
113-
let clImage = clContext.CreateClArray<_> img
114-
115-
//let mutable res = None
116-
let mutable input = clImage// clContext.CreateClArray(img.Length, allocationMode = AllocationMode.Default)
117-
let mutable output = clContext.CreateClArray(img.Length, allocationMode = AllocationMode.Default)
131+
fun (filters: list<float32[][]>) (img: Image) ->
132+
133+
let mutable input = clContext.CreateClArray<_> img.Data
134+
let mutable output = clContext.CreateClArray(img.Data.Length, allocationMode = AllocationMode.Default)
118135

119136
for filter in filters do
120137
let filter = Array.concat filter
121138
let filterD = (Array.length filter) / 2
122-
let clFilter = clContext.CreateClArray<_> filter
139+
let clFilter = clContext.CreateClArray<_>(filter,HostAccessMode.NotAccessible,DeviceAccessMode.ReadOnly)
123140
let oldInput = input
124-
input <- kernel queue clFilter filterD input imgH imgW output
141+
input <- kernel queue clFilter filterD input img.Height img.Width output
125142
output <- oldInput
126143
queue.Post(Msg.CreateFreeMsg clFilter)
127144

128-
let result' = Array.zeroCreate (imgH * imgW)
129-
let result' = queue.PostAndReply(fun ch -> Msg.CreateToHostMsg(input, result', ch))
130-
let result = Array2D.zeroCreate imgH imgW
131-
Array.Parallel.iteri (fun x v -> result.[x / imgW, x % imgW] <- v) result'
145+
let result = Array.zeroCreate (img.Height * img.Width)
146+
let result = queue.PostAndReply(fun ch -> Msg.CreateToHostMsg(input, result, ch))
132147
queue.Post(Msg.CreateFreeMsg input)
133148
queue.Post(Msg.CreateFreeMsg output)
134-
result
149+
Image (result, img.Width, img.Height, img.Name)

‎src/ImageProcessing/Main.fs‎

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,18 +8,27 @@ module Main =
88
let demoFile = System.IO.Path.Combine(inputFolder, "armin-djuhic-ohc29QXbS-s-unsplash.jpg")
99
[<EntryPoint>]
1010
let main (argv: string array) =
11-
let device =
11+
let nvidiaDevice =
1212
ClDevice.GetAvailableDevices(platform=Platform.Nvidia) |> Seq.head
13+
let intelDevice =
14+
ClDevice.GetAvailableDevices(platform=Platform.Intel) |> Seq.head
1315
//ClDevice.GetFirstAppropriateDevice()
14-
printfn $"Device: %A{device.Name}"
16+
//printfn $"Device: %A{device.Name}"
1517

16-
let context = ClContext(device)
17-
let applyFiltersGPU = ImageProcessing.applyFiltersGPU context 64
18+
let nvContext = ClContext(nvidiaDevice)
19+
let applyFiltersOnNvGPU = ImageProcessing.applyFiltersGPU nvContext 64
20+
21+
let intelContext = ClContext(intelDevice)
22+
let applyFiltersOnIntelGPU = ImageProcessing.applyFiltersGPU intelContext 64
23+
24+
let filters = [ImageProcessing.gaussianBlurKernel;ImageProcessing.gaussianBlurKernel;ImageProcessing.edgesKernel]
1825

1926
//let grayscaleImage = ImageProcessing.loadAs2DArray demoFile
2027
//let blur = ImageProcessing.applyFilter ImageProcessing.gaussianBlurKernel grayscaleImage
2128
//let edges = ImageProcessing.applyFilter ImageProcessing.edgesKernel blur
2229
//let edges = applyFiltersGPU [ImageProcessing.gaussianBlurKernel; ImageProcessing.edgesKernel] grayscaleImage
2330
//ImageProcessing.save2DByteArrayAsImage edges "../../../../../out/demo_grayscale.jpg"
24-
Streaming.processAllFiles inputFolder "../../../../../out/" (applyFiltersGPU [ImageProcessing.gaussianBlurKernel;ImageProcessing.gaussianBlurKernel;ImageProcessing.edgesKernel])
31+
let start = System.DateTime.Now
32+
Streaming.processAllFiles inputFolder "../../../../../out/" [applyFiltersOnNvGPU filters; applyFiltersOnIntelGPU filters]
33+
printfn $"TotalTime = %f{(System.DateTime.Now - start).TotalMilliseconds}"
2534
0

‎src/ImageProcessing/Streaming.fs‎

Lines changed: 25 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,18 @@
11
module ImageProcessing.Streaming
22

3+
open ImageProcessing.ImageProcessing
4+
35
let listAllFiles dir =
46
let files = System.IO.Directory.GetFiles dir
57
List.ofArray files
68

79
type msg =
8-
| Img of string*byte[,]
10+
| Img of Image
911
| EOS of AsyncReplyChannel<unit>
1012

1113
let imgSaver outDir =
12-
let outFile (fileFullPath:string) =
13-
System.IO.Path.Combine(outDir, System.IO.Path.GetFileName fileFullPath)
14+
let outFile (imgName:string) =
15+
System.IO.Path.Combine(outDir, imgName)
1416

1517
MailboxProcessor.Start(fun inbox ->
1618
let rec loop () =
@@ -20,9 +22,9 @@ let imgSaver outDir =
2022
| EOS ch ->
2123
printfn "Image saver is finished!"
2224
ch.Reply()
23-
| Img (file, img) ->
24-
printfn $"Save: %A{file}"
25-
ImageProcessing.save2DByteArrayAsImage img (outFile file)
25+
| Img img ->
26+
printfn $"Save: %A{img.Name}"
27+
saveImage img (outFile img.Name)
2628
return! loop ()
2729
}
2830
loop ()
@@ -42,19 +44,28 @@ let imgProcessor filterApplicator (imgSaver:MailboxProcessor<_>) =
4244
imgSaver.PostAndReply EOS
4345
printfn "Image processor is finished!"
4446
ch.Reply()
45-
| Img (file,img) ->
46-
printfn $"Filter: %A{file}"
47+
| Img img ->
48+
printfn $"Filter: %A{img.Name}"
4749
let filtered = filter img
48-
imgSaver.Post (Img (file,filtered))
50+
imgSaver.Post (Img filtered)
4951
return! loop (not cnt)
5052
}
5153
loop true
5254
)
5355

54-
let processAllFiles inDir outDir filterApplicator =
55-
let imgSaver = imgSaver outDir
56-
let imgProcessor = imgProcessor filterApplicator imgSaver
56+
let processAllFiles inDir outDir filterApplicators =
57+
let mutable cnt = 0
58+
let imgProcessors =
59+
filterApplicators
60+
|> List.map (fun x ->
61+
let imgSaver = imgSaver outDir
62+
imgProcessor x imgSaver
63+
)
64+
|> Array.ofList
5765
let filesToProcess = listAllFiles inDir
5866
for file in filesToProcess do
59-
imgProcessor.Post <| Img(file, ImageProcessing.loadAs2DArray file)
60-
imgProcessor.PostAndReply EOS
67+
(imgProcessors
68+
|> Array.minBy(fun p -> p.CurrentQueueLength)).Post <| Img(loadAsImage file)
69+
cnt <- cnt + 1
70+
for imgProcessor in imgProcessors do imgProcessor.PostAndReply EOS
71+
//imgSaver.PostAndReply EOS

0 commit comments

Comments
 (0)