Blend two trends

Share your advanced PureBasic knowledge/code with the community.
Seymour Clufley
Addict
Addict
Posts: 1265
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Blend two trends

Post by Seymour Clufley »

To people who are better at maths than I am, this code will probably be obvious. For me, however, it was a morning's work and I think it may be useful to people who are similarly disadvantaged in the maths department.

What it does: it calculates a trend that is always exactly halfway between two other trends.

It's done with arrays rather than lists, because you can get the previous "element" in an array without changing the current element, making the code a bit simpler.

For the demo, Trend-1 is drawn in red, Trend-2 is drawn in blue, and the "blend trend" is drawn in purple (halfway between red and blue!).

Hope someone can use it!

Code: Select all

#Purple = 16711808
Global c13.s = Chr(13)
Macro R(t)
	MessageRequester("Report",t,0)
EndMacro

Structure PointF
	x.f
	y.f
EndStructure





Procedure.f Defeat(a.f,b.f)
	
	If a<b
		ProcedureReturn a
	EndIf
	ProcedureReturn b
	
EndProcedure

Procedure.f Beat(a.f,b.f)
	
	If a>b
		ProcedureReturn a
	EndIf
	ProcedureReturn b
	
EndProcedure

Procedure.f Difference(a.f,b.f)
	
	If a>b
		ProcedureReturn a-b
	EndIf
	ProcedureReturn b-a
	
EndProcedure


Procedure.b GetTrendWidthAndHeight(Array arr.PointF(1),*awidth,*aheight)
	
	For p = 1 To ArraySize(arr(),1)
		awidth.f = Beat(awidth,arr(p)\x)
		aheight.f = Beat(aheight,arr(p)\y)
	Next p
	
	PokeF(*awidth,awidth)
	PokeF(*aheight,aheight)
	
	ProcedureReturn #True
EndProcedure

Procedure.b MatchTrendWidths(Array a.PointF(1),Array b.PointF(1))
	
	apoints = ArraySize(a(),1)
	bpoints = ArraySize(b(),1)
	
	GetTrendWidthAndHeight(a(),@awidth.f,@aheight.f)
	GetTrendWidthAndHeight(b(),@bwidth.f,@bheight.f)
	
	If bwidth>awidth
		; stretch Trend-A...
		For p = 1 To apoints
			a(p)\x = a(p)\x/awidth*bwidth
		Next p
	Else
		; stretch Trend-B...
		For p = 1 To bpoints
			b(p)\x = b(p)\x/bwidth*awidth
		Next p
	EndIf
	
EndProcedure

Procedure.b StretchTrendToWidth(Array arr.PointF(1),tw.f)
	
	GetTrendWidthAndHeight(arr(),@awidth.f,@aheight.f)
	
	For p = 1 To ArraySize(arr(),1)
		arr(p)\x = arr(p)\x/awidth*tw
	Next p
	
EndProcedure


Procedure.f GetYLevelInTrend(Array arr.PointF(1),tx.f)
	
	points = ArraySize(arr(),1)
	For p = 1 To points
		If arr(p)\x<tx : Continue : EndIf
		
		l = p-1
		
		If arr(p)\x>tx
			r = p
			Break
		EndIf
		
	Next p
	If Not l
		l = 1
	EndIf
	If Not r
		r = points
	EndIf
	
	
	xspan.f = arr(r)\x - arr(l)\x
	xdist.f = tx - arr(l)\x
	If arr(r)\y>arr(l)\y
		neg.b = #False
	Else
		neg.b = #True
	EndIf
	yspan.f = Difference(arr(l)\y,arr(r)\y)
	ydist.f = yspan/xspan*xdist
	
	
	my.f
	If neg
		my = arr(l)\y-ydist
	Else
		my = arr(l)\y+ydist
	EndIf
	
	;If xspan
	;	followpc.f = 100/xspan*xdist
	;EndIf
	;t.s = "Target x: "+StrF(tx,0)+c13+"Between points "+Str(l)+" ("+StrF(arr(l)\x,0)+") and "+Str(r)+" ("+StrF(arr(r)\x,0)+")"+c13
	;If neg
	;	t + "-"
	;EndIf
	;t + StrF(followpc,0)+"% between "+StrF(arr(l)\y,0)+" and "+StrF(arr(r)\y,0)+": "+StrF(my,0)
	;R(t)
	
	ProcedureReturn my
	
EndProcedure

Procedure.f HalfwayBetween(a.f,b.f)
	dif.f = Difference(a,b)
	If a>b
		h.f = a-(dif/2)
	Else
		h.f = a+(dif/2)
	EndIf
	ProcedureReturn h
EndProcedure

Procedure.b BlendTrends(Array a.PointF(1),Array b.PointF(1),Array m.PointF(1))
	
	apoints = ArraySize(a(),1)
	bpoints = ArraySize(b(),1)
	
	
	NewList blend.PointF()
	
	For p = 1 To apoints
		x.f = a(p)\x
		y1.f = a(p)\y
		y2.f = GetYLevelInTrend(b(),x)
		
		AddElement(blend()) : blend()\x=x : blend()\y=HalfwayBetween(y1,y2)
	Next p
	For p = 1 To bpoints
		x.f = b(p)\x
		y1.f = b(p)\y
		y2.f = GetYLevelInTrend(a(),x)
		
		AddElement(blend()) : blend()\x=x : blend()\y=HalfwayBetween(y1,y2)
	Next p
	
	SortStructuredList(blend(),#PB_Sort_Ascending,OffsetOf(PointF\x),#PB_Sort_Float)
	
	Dim m(ListSize(blend()))
	p=0
	ForEach blend()
		p+1
		m(p)\x = blend()\x
		m(p)\y = blend()\y
	Next
	
EndProcedure


Procedure.i DrawGraph(Array arr.PointF(1),gw.f,gh.f,clr=#White)
	
	points = ArraySize(arr(),1)
	
	img = CreateImage(#PB_Any,gw,gh,32|#PB_Image_Transparent)
	
	xzoom.f = 1
	yzoom.f = 1
	
	nclr = RGBA(Red(clr),Green(clr),Blue(clr),255)
	
	StartDrawing(ImageOutput(img))
	DrawingMode(#PB_2DDrawing_AllChannels)
	For p = 2 To points
		x1.f = arr(p-1)\x
		y1.f = arr(p-1)\y
		x2.f = arr(p)\x
		y2.f = arr(p)\y
		LineXY(x1*xzoom,gh-(y1*yzoom),x2*xzoom,gh-(y2*yzoom),nclr)
	Next p
	StopDrawing()
	
	ProcedureReturn img
	
EndProcedure





gw = 1280 : gh = 640

; generate random trend 1...
points = 9
Dim arr1.PointF(points)
For p = 2 To points
	arr1(p)\x = arr1(p-1)\x + Random(50)+5
	arr1(p)\y = Random(gh)
Next p
StretchTrendToWidth(arr1(),gw) ; horizontal stretch
img1 = DrawGraph(arr1(),gw,gh,#Red)

; generate random trend 2...
points = 5
Dim arr2.PointF(points)
For p = 2 To points
	arr2(p)\x = arr2(p-1)\x + Random(50)+5
	arr2(p)\y = Random(gh)
Next p
StretchTrendToWidth(arr2(),gw) ; horizontal stretch
img2 = DrawGraph(arr2(),gw,gh,#Blue)


; calculate "blend" trend...
Dim blendarr.PointF(0)
BlendTrends(arr1(),arr2(),blendarr())
blendimg = DrawGraph(blendarr(),gw,gh,#Purple)


; make composite image of the three trends...
compositeimg = CreateImage(#PB_Any,gw,gh,32)
StartDrawing(ImageOutput(compositeimg))
	DrawAlphaImage(ImageID(img1),0,0)
	DrawAlphaImage(ImageID(img2),0,0)
	DrawAlphaImage(ImageID(blendimg),0,0)
	DrawingMode(#PB_2DDrawing_AlphaBlend)
	For p = 1 To ArraySize(arr1(),1) : Break
		Line(arr1(p)\x,0,1,gh,RGBA(255,0,0,92))
		Line(0,gh-arr1(p)\y,gw,1,RGBA(255,0,0,92))
	Next p
	For p = 1 To ArraySize(arr2(),1) : Break
		Line(arr2(p)\x,0,1,gh,RGBA(0,0,255,92))
		Line(0,gh-arr2(p)\y,gw,1,RGBA(0,0,255,92))
	Next p
StopDrawing()
FreeImage(img1)
FreeImage(img2)
FreeImage(blendimg)


; display composite image...
win = OpenWindow(#PB_Any,0,0,gw,gh,"Demo",#PB_Window_ScreenCentered)
ImageGadget(#PB_Any,0,0,0,0,ImageID(compositeimg))
Repeat
	we = WindowEvent()
	If Not we
		Delay(50)
		Continue
	EndIf
Until GetAsyncKeyState_(#VK_ESCAPE) Or GetAsyncKeyState_(#VK_SPACE) Or GetAsyncKeyState_(#VK_RETURN)
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."
Nituvious
Addict
Addict
Posts: 1029
Joined: Sat Jul 11, 2009 4:57 am
Location: United States

Re: Blend two trends

Post by Nituvious »

What is this I don't even know... And things I don't understand make me scared :oops:
I am learning a lot from the code though, thank you for posting.
▓▓▓▓▓▒▒▒▒▒░░░░░
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Re: Blend two trends

Post by gnasen »

I just had a fast look on it, but it seems that you make some things more complicated then they are. Too example:

Code: Select all

Procedure.f Difference(a.f,b.f)
  If a>b
    ProcedureReturn a-b
  EndIf
  ProcedureReturn b-a
EndProcedure

Procedure.f HalfwayBetween(a.f,b.f)
  dif.f = Difference(a,b)
  If a>b
    h.f = a-(dif/2)
  Else
    h.f = a+(dif/2)
  EndIf
  ProcedureReturn h
EndProcedure
can be replaced by:

Code: Select all

Procedure.f HalfwayBetween(a.f,b.f)
  ProcedureReturn b+(a-b)/2
EndProcedure
Just substitute the "Difference" procedures code into the one from "halfwaybetween" and you will see that both things are exactly the same. I think you could learn very much for yourself, if you try to rewrite your code and try to shorten it.
I dont want to denigrate your effort, the code does what you want it to do and works very fine. Just see it as a challenge :D
pb 5.11
User avatar
kenmo
Addict
Addict
Posts: 2047
Joined: Tue Dec 23, 2003 3:54 am

Re: Blend two trends

Post by kenmo »

gnasen wrote:

Code: Select all

Procedure.f HalfwayBetween(a.f,b.f)
  ProcedureReturn b+(a-b)/2
EndProcedure
which can be replaced by

Code: Select all

Procedure.f HalfwayBetween(a.f,b.f)
  ProcedureReturn (a + b)/2.0
EndProcedure
which is simply the average!
Post Reply