Heatmap [WIP]

[Derren]

Hallo zusammen,

hier ein kleiner Code zum generieren einer "Heatmap", wie man es vielleicht von Wetterkarten kennt.




Wenn man den Farbgradienten um Alphawerte erweitert und die Draw()-Funktion mit dem AlphaBlend Modus erweitert, kann z.B. sowas bauen.


Der Code ist gerade erst entstanden, also weder ordentlich kommentiert noch optimiert (bei jedem Click eine "Heatsource" hinzugefügt und alles komplett neu berechnet, das Erstellen der Karte dauert also nach jedem Klick länger).

Ich habe schon einige Ideen, wie das ganze optimiert werden kann.
Zum einen nicht immer alles neuberechnen, sondern das Ergebnis zwischenspeichern und nur mit den neuen Daten nach einem Klick zusammenführen.
Zum anderen diese ganzen Cos/Sin-Berechnungen aus dem Loop rausziehen und einmal für jeden Kreis (gegeben durch Radius und Gradient-Funktion) eine Punktmatrix erstellen.
Und dann halt noch Schönheitskram, wie nicht-hardcoded Farbverläufe, Overlay-Transparenz, Import/Export etc.

Code: Alles auswählen

DeclareModule Heatmap
	
	Structure __struct_Heatmap
		width.i
		height.i
		Array pixelValues.d(1)
	EndStructure 
	
	Global Dim __ListOfHeatmaps.__struct_Heatmap(100)
	
	Declare Create(width.i, height.i)
	Prototype.d pGradient(varRadius_between_0_and_1.d)
	Declare NewCircleTemplate(radius, *callback.pGradient )
	Declare AddPoint(heatmap, template, x, y, intensity.d=1.0)	
EndDeclareModule 

Module Heatmap
	
	Structure __struct_circleTemplate
		diameter.i
		Array pixelValues.d(1)
	EndStructure 
	
	Global Dim __ListOfCircleTemplates.__struct_circleTemplate(100)

	

	

	Global __index_ListOfHeatmaps.i
	Global __index_ListOfCircleTemplates.i	
	
	Procedure Create(width.i, height.i) ; => ID of Heatmap
		__ListOfHeatmaps(__index_ListOfHeatmaps)\width = width
		__ListOfHeatmaps(__index_ListOfHeatmaps)\height = height
		ReDim __ListOfHeatmaps(__index_ListOfHeatmaps)\pixelValues(width*height)
		__index_ListOfHeatmaps + 1
		ProcedureReturn __index_ListOfHeatmaps - 1
	EndProcedure 
	
	
	Procedure NewCircleTemplate(radius, *callback.pGradient)
		Protected.i x,y,v,i
		Protected alpha.d
		Protected r.i
		Protected diameter = radius*2
		Protected.d radius_normiert
		
		
		__ListOfCircleTemplates(__index_ListOfCircleTemplates)\diameter = diameter
		ReDim __ListOfCircleTemplates(__index_ListOfCircleTemplates)\pixelValues((diameter)*(diameter))
		
		For i = 1 To 3600
				alpha + 0.1
				;LineXY(circles()\x, circles()\y, circles()\radius * Cos(Radian(alpha)) +circles()\x, circles()\radius * Sin(Radian(alpha)) +circles()\y, $0000FF)
				
				For r=0 To radius
					x=Int(Round(r * Cos(Radian(alpha)) + radius, #PB_Round_Nearest))
					y=Int(Round(r * Sin(Radian(alpha)) + radius, #PB_Round_Nearest))				
					
					v = x + y*diameter
					
					radius_normiert = 1.0*r/radius
					;Debug x + y*diameter
					If v<=diameter*diameter
						__ListOfCircleTemplates(__index_ListOfCircleTemplates)\pixelValues( x + y*diameter)  = *callback(radius_normiert)
					EndIf 
					
				Next 
				
				
			Next 	
		
		
		
		__index_ListOfCircleTemplates + 1		
		ProcedureReturn __index_ListOfCircleTemplates - 1
	EndProcedure 
	
	Procedure AddPoint(heatmap, template, PointX, PointY, intensity.d=1.0)
		Protected w = __ListOfHeatmaps(heatmap)\width
		Protected h = __ListOfHeatmaps(heatmap)\height
		Protected A = w*h ; "Area" of Heatmap = Number of Points
		Protected d = __ListOfCircleTemplates(template)\diameter
		Protected d2 = (d*d)-1 ;-1 because Arrays start at 0
		
		Protected x_orig = PointX-(d/2)
		Protected y_orig = PointY-(d/2)
		
		Protected x,y ;x,y within the Template --> x+x_orig = x within the heatmap etc.
		Protected i 
		
		Protected pointN
		
		
		For i=0 To d2
			If x>=d
				x=0
				y+1
			EndIf 
			
			
			
			pointN = (y+y_orig)*w + (x+x_orig) ;y within in the Heatmap is line number (y) * width of heightmap.  
			
			If pointN >=0 And pointN <A
				
				
				
				__ListOfHeatmaps(heatmap)\pixelValues(pointN) + (__ListOfCircleTemplates(template)\pixelValues(y*d + x) * intensity)
				
			EndIf
			
			x+1
		Next
		
		
	EndProcedure 
	
EndModule 
;-> EndModule 
Procedure.d testGradient(val.d)
	ProcedureReturn 1-val
EndProcedure 

;{
Global Dim HMG(101)

HMG(000) = RGBA(0,$FF,$4A,0);$000000
HMG(001) = RGBA(0,$FF,$4A,50);$3F1200
HMG(002) = RGBA(0,$FF,$4A,100);$7F2500
HMG(003) = RGBA(0,$FF,$4AF,150);$BF3700
HMG(004) = RGBA(0,$FF,$4A,200);$FF4A00
HMG(005) = $D46803
HMG(006) = $AA8606
HMG(007) = $7FA409
HMG(008) = $55C20C
HMG(009) = $2AE00F
HMG(010) = $00FF12
HMG(011) = $00FF23
HMG(012) = $00FF2C
HMG(013) = $00FF35
HMG(014) = $00FF3D
HMG(015) = $00FF48
HMG(016) = $00FF4F
HMG(017) = $00FF58
HMG(018) = $00FF61
HMG(019) = $00FF69
HMG(020) = $00FF72
HMG(021) = $00FF7B
HMG(022) = $00FF84
HMG(023) = $00FF8C
HMG(024) = $00FF95
HMG(025) = $00FF9E
HMG(026) = $00FFA7
HMG(027) = $00FFB0
HMG(028) = $00FFC1
HMG(029) = $00FFCA
HMG(030) = $00FFD3
HMG(031) = $00FFDB
HMG(032) = $00FFE4
HMG(033) = $00FFED
HMG(034) = $00FFF6
HMG(035) = $00FFFF
HMG(036) = $00FBFF
HMG(037) = $00F7FF
HMG(038) = $00F3FF
HMG(039) = $00EFFF
HMG(040) = $00EBFF
HMG(041) = $00E7FF
HMG(042) = $00E3FF
HMG(043) = $00DFFF
HMG(044) = $00DBFF
HMG(045) = $00D7FF
HMG(046) = $00D3FF
HMG(047) = $00CFFF
HMG(048) = $00CBFF
HMG(049) = $00C7FF
HMG(050) = $00C3FF
HMG(051) = $00BFFF
HMG(052) = $00BBFF
HMG(053) = $00B7FF
HMG(054) = $00B3FF
HMG(055) = $00AFFF
HMG(056) = $00ABFF
HMG(057) = $00A7FF
HMG(058) = $00A3FF
HMG(059) = $009FFF
HMG(060) = $009BFF
HMG(061) = $0097FF
HMG(062) = $0093FF
HMG(063) = $008FFF
HMG(064) = $008BFF
HMG(065) = $0087FF
HMG(066) = $0083FF
HMG(067) = $007FFF
HMG(068) = $007BFF
HMG(069) = $0077FF
HMG(070) = $0073FF
HMG(071) = $006FFF
HMG(072) = $006BFF
HMG(073) = $0067FF
HMG(074) = $0063FF
HMG(075) = $005FFF
HMG(076) = $005BFF
HMG(077) = $0057FF
HMG(078) = $0053FF
HMG(079) = $004FFF
HMG(080) = $004BFF
HMG(081) = $0047FF
HMG(082) = $0043FF
HMG(083) = $003FFF
HMG(084) = $003BFF
HMG(085) = $0037FF
HMG(086) = $0033FF
HMG(087) = $002FFF
HMG(088) = $002BFF
HMG(089) = $0027FF
HMG(090) = $0023FF
HMG(091) = $001FFF
HMG(092) = $001BFF
HMG(093) = $0017FF
HMG(094) = $0013FF
HMG(095) = $000FFF
HMG(096) = $000BFF
HMG(097) = $0007FF
HMG(098) = $0003FF
HMG(099) = $0000FF
HMG(100) = $0000FF



For i=5 To 100
	HMG(i) = RGBA(Red(HMG(i)), Green(HMG(i)), Blue(HMG(i)), 100)
Next 

;}

Procedure.i myColors(val.d);0=rot, 1=grün
	
	If val>1 : val=1 : EndIf 
	If val<0 : val=0 : EndIf 
	
	ProcedureReturn HMG(Int(val*100))	
EndProcedure 

Define myHeatmap = Heatmap::Create(500,500)
Define myCircleTemplate = Heatmap::NewCircleTemplate(50, @testGradient())


Heatmap::AddPoint(myHeatmap, myCircleTemplate, 100, 100)
Heatmap::AddPoint(myHeatmap, myCircleTemplate, 100, 100, -1)

UsePNGImageDecoder()



Global img = LoadImage(0, "map_heatmap.png")


Procedure draw()	
	Protected n, x, y	
	StartDrawing(CanvasOutput(0))
		
		Box(0, 0, 500, 500, $FFFFFF)
		
		If img
			DrawImage(ImageID(0), 0, 0)
		EndIf 
		
		DrawingMode(#PB_2DDrawing_AlphaBlend )
	For n=0 To 249999 ;=500*500 - 1
		
		If x>=500
			x=0
			y+1			
		EndIf 
		
		Plot(  x,y,  myColors( Heatmap::__ListOfHeatmaps(myHeatmap)\pixelValues(n)  )  )
		x+1		
	Next 	
StopDrawing()
EndProcedure 

OpenWindow(0, 0, 0, 500, 500, "test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 500 , 500)
draw()

Repeat 
	e=WaitWindowEvent()
	If e=#PB_Event_Gadget And EventGadget()=0
		
		If EventType() = #PB_EventType_LeftClick			
			Heatmap::AddPoint(myHeatmap, myCircleTemplate, GetGadgetAttribute(0, #PB_Canvas_MouseX), GetGadgetAttribute(0, #PB_Canvas_MouseY), 0.25)
			draw()
		EndIf 
		
		If EventType() = #PB_EventType_RightClick			
			Heatmap::AddPoint(myHeatmap, myCircleTemplate, GetGadgetAttribute(0, #PB_Canvas_MouseX), GetGadgetAttribute(0, #PB_Canvas_MouseY), -0.25)
			draw()
		EndIf 
	EndIf 
Until e=#PB_Event_CloseWindow
End 

[/size]

[TheCube]

Nette Idee .. etwas ausgebaut vielleicht zur Doku/Illustration zu nutzen, wenn keine Wärmebildkamera zur Hand,
und man sich nicht per Grafikprogramm helfen kann.
Stelle mir da ein Graustufen-Hintergrundbild eines PC-Mainboards vor und man markiert die Hitze-Hotspots darauf.
Also Bild einladbar und im Canvas verkleinert im Hintergrund angezeigt.
(Beispiel: https://www.heise.de/ct/artikel/Wasser- ... 64154.html)
Dann natürlich kreiertes Gesamtbild speicherbar.

Sonstige Ideen:
- Die Geschwindigkeit wie schon von dir angemerkt
- Die "Farbbatzen" klein/mittel/gross und in "Temperatur" wählbar. (->Um z.B. größere grün-gelbe Bereiche erstellen zu können)

[Derren]

Also die Größe kannst du wählen.
Das ist ja nur eine schnelle Demo, von daher ist da jetzt keine GUI dafür eingebaut.

Code: Alles auswählen

If EventType() = #PB_EventType_LeftClick
			AddElement(circles()) : circles()\x = GetGadgetAttribute(0, #PB_Canvas_MouseX) : circles()\y =  GetGadgetAttribute(0, #PB_Canvas_MouseY) : circles()\centerValue = 80 : circles()\radius = 50 
			draw()
		EndIf 

circles()\radius gibt die Größe des gesamten Kreises an
circles()\centerValue gibt gibt quasi die "Kerntemperatur" des Blobs an. Aktuelle bei 80, d.h. ein Blob ist noch nicht wirklich rot. Zwei Blobs auf dem selben Punkt sind dann schon bei 160, und 3 bei 240 (der Max-Wert ist aktuell 255, mal schauen ob ich das auf 100 oder 1000 normiere)

Um grüne Flächen zu bekommen, könntest du z.B. viele Blobs mit einer Kerntemperatur von 25 malen.
(Zu Grunde liegt dieser Gradient (den ich hardcoded in das Array gepackt habe)

Da sieht man: Grün = 10, allerdings geht der Gradientmaker von 0 bis 100 und da der Max-Wert der "Temperatur" bei 255 liegt braucht man also eine Temperatur von 25 um grün zu bekommen.
Den Gradient kann man natürlich anpassen. z,B. Grün bis 90 und ziemlich schnell orange und rot.

Die letzte Möglichkeit ist die Funktion myLinearGradient(), die aktuell einen linearen Wert, abhängig vom Radius zurückgibt. Die könnte man natürlich auch logarithmisch oder wie auch immer schreiben.
Die Funktion gibt auch die tatsächlichen Werte (normiert, zwischen 0 und dem Maxwert, eben) zurück, der Farbverlauf ist ja nur eine visuelle Darstellung. Da könnte man auch sagen "kalt=rot und warm=grün" um z.B. frostgefährdete Stellen zu markieren.

[Derren]

Update:
Das ganze ist mal in Modul geschoben.

Aktuell werden 3 Funktionen bereitgestellt:

Code: Alles auswählen

myHeatmap = Heatmap::Create(500,500) ;Erstelle eine Heatmap mit den Dimensionen W, H
myCircleTemplate = Heatmap::NewCircleTemplate(50, @testGradient()) ;Erstelle neues Template für kreisförmige "HeatSource", mit Radius 50 und @callback() als Funktion "Abstand vom Mittelpunkt -> Intensität"
Heatmap::AddPoint(myHeatmap, myCircleTemplate, 100, 100, [1.0]) ;Erstellt eine Heatsource auf der angegeben Heatmap, mit dem angegeben Template
Heatmap::AddPoint(myHeatmap, myCircleTemplate, 100, 100, -1) ;Letzer Parameter = Intensität (optional) kann auch negativ sein. So können Punkte wieder entfernt werden

Geschwindkeit nimmt jetzt nicht mehr mit jedem neuen Punkt ab. Recht viel schneller wird's wohl aber nicht werden, da jedesmal die komplette Heatmap (im Beispiel 500x500 pixel) Pixel um Pixel mit Plot() gezeichnet wird.

Ob sich das Programm, wie ich es mir vorstelle auch mit den Gradient-Drawing Funktionen von PB umsetzen lässt, werde ich demnächst mal testen.

[dige]

Wollte es gerade mal testen, erhalte aber folgende Fehlermeldung:

Code: Alles auswählen

 [COMPILER] Zeile 239: Modul-Element 'Create()' ist nicht als 'public' deklariert.

[Derren]

Eha, probier jetzt mal.
Irgendwas mach ich bei Copy&Paste falsch... Ist nicht das erste mal, dass beim Code im Post irgendwo eine Zeile fehlt