PureBoard

Code: Alles auswählen

sudo apt-get install libcminpack-dev

Code: Alles auswählen

DeclareModule CMinPackType
	#USE_DOUBLE = #True
	
	CompilerIf #USE_DOUBLE
		Macro Real : Double: EndMacro
		Macro r : d: EndMacro
		Macro func(name) : name : EndMacro
	CompilerElse
		Macro Real : Double: EndMacro
		Macro r : d: EndMacro
		Macro func(name) : s#name : EndMacro
	CompilerEndIf
	Structure RealArray
		r.r[0]
	EndStructure
	Structure LongArray
		l.l[0]
	EndStructure
EndDeclareModule
Module CMinPackType
EndModule

DeclareModule CMinPack
	UseModule CMinPackType

	; For hybrd1 and hybrd:
	;    Calculate the functions at x and return this vector in fvec.
	;    Return a negative value to terminate hybrd1/hybrd.
	PrototypeC.l cminpack_func_nn(*p, n.l, *x.RealArray, *fvec.RealArray, iflag.l)
	
	; For hybrj1 and hybrj:
	;    If iflag = 1 calculcate the function at x and return this vector in fvec. Do not alter fjac.
	;    If iflag = 2 calculate the jacobian at x and return this matrix in fjac. Do not alter fvec.
	;    Return a negative value to terminate hybrj1/hybrj.
	PrototypeC.l cminpack_funcder_nn(*p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l, iflag.l)
	
	; For lmdif1 and lmdif
	;    calculate the functions at x and return this vector in fvec.
	;    If iflag = 1 the result is used to compute the residuals.
	;    If iflag = 2 the result is used to compute the jacobian by finite differences.
	;    Jacobian computation requires exactly n function calls with iflag = 2.
	;    Return a negative value to terminate lmdif1/lmdif.
	PrototypeC.l cminpack_func_mn(*p, m.l, n.l, *x.RealArray, *fvec.RealArray, iflag.l)
	
	; For lmder1 and lmder:
	;    If iflag = 1 calculate the functions at x and return this vector in fvec. Do not alter fjac.
	;    If iflag = 2 calculate the jacobian at x and return this matrix in fjac. Do not alter fvec.
	;    Return a negative value to terminate lmder1/lmder.
	PrototypeC.l cminpack_funcder_mn(*p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l, iflag.l)
	
	; For lmstr1 and lmstr:
	;    If iflag = 1 calculate the functions at x and return this vector in fvec.
	;    If iflag = i calculate the (i-1)-st row of the jacobian at x and return this vector in fjrow.
	;    Return a negative value to terminate lmstr1/lmstr.
	PrototypeC.l cminpack_funcderstr_mn(*p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjrow.RealArray, iflag.l)

	; Find a zero of a system of N nonlinear functions in N variables by
	; a modification of the Powell hybrid method (Jacobian calculated by
	; a forward-difference approximation).
	Declare.l func(hybrd1)(*fcn_nn.cminpack_func_nn, *p, n.l, *x.RealArray, *fvec.RealArray, tol.r, *wa.RealArray, lwa.l)
	
	; Find a zero of a system of N nonlinear functions in N variables by
	; a modification of the Powell hybrid method (Jacobian calculated by
	; a forward-difference approximation, more general).
	Declare.l func(hybrd)(*fcn_nn.cminpack_func_nn, *p, n.l, *x.RealArray, *fvec.RealArray, xtol.r, maxfev.l, ml.l, mu.l,
		        epsfcn.r, *diag.RealArray, mode.l, factor.r, nprint.l, *nfev.Long, *fjac.RealArray,
		        ldfjac.l, *r.RealArray, lr.l, *qtf.Real, *wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
	
	; Find a zero of a system of N nonlinear functions in N variables by
	; a modification of the Powell hybrid method (user-supplied Jacobian).
	Declare.l func(hybrj1)(*fcnder_nn.cminpack_funcder_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l,
				tol.l, *wa.RealArray, lwa.l)
	
	; Find a zero of a system of N nonlinear functions in N variables by
	; a modification of the Powell hybrid method (user-supplied Jacobian,
	; more general).
	Declare.l func(hybrj)(*fcnder_nn.cminpack_funcder_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l,
				xtol.r, maxfev.l, *diag.RealArray, mode.l, factor.r, nprint.l, *nfev.Long, *njev.Long,
				*r.RealArray, lr.l, *qtf.RealArray, *wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (Jacobian calculated by a forward-difference approximation).
	Declare.l func(lmdif1)(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, tol.r,
				*iwa.Long, *wa.RealArray, lwa.l)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (Jacobian calculated by a forward-difference approximation, more
	; general).
	Declare.l func(lmdif)(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, ftol.r,
				xtol.r, gtol.r, maxfev.l, epsfcn.r, *diag.RealArray, mode.l, factor.r,
				nprint.l, *nfev.Long, *fjac.RealArray, ldfjac.l, *ipvt.Long, *qtf.RealArray,
				*wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (user-supplied Jacobian).
	Declare.l func(lmder1)(*fcnder_mn.cminpack_funcder_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
				ldfjac.l, tol.r, *ipvt.Long, *wa.RealArray, lwa.l)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (user-supplied Jacobian, more general).
	Declare.l func(lmder)(*fcnder_mn.cminpack_funcder_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
				ldfjac.l, ftol.r, xtol.r, gtol.r, macfev.l, *diag.RealArray, mode.l, factor.r,
				nprint.l, *nfev.Long, *njev.Long, *ipvt.Long, *qtf.RealArray, *wa1.RealArray,
				*wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (user-supplied Jacobian, minimal storage).
	Declare.l func(lmstr1)(*fcnderstr_mn.cminpack_funcderstr_mn, *p, m.l, n.l, *x.RealArray,*fvec.RealArray, *fjac.RealArray,
				ldfjac.l, tol.r, *ipvt.Long, *wa.RealArray, lwa.l)
	
	; Minimize the sum of the squares of nonlinear functions in N
	; variables by a modification of the Levenberg-Marquardt algorithm
	; (user-supplied Jacobian, minimal storage, more general).
	Declare.l func(lmstr)(*fcnderstr_mn.cminpack_funcderstr_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
				ldfjac.l, ftol.r, xtol.r, gtol.r, maxfev.l, *diag.RealArray, mode.l, factor.r,
				nprint.l, *nfev.Long, *njev.Long, *ipvt.Long, *qtf.RealArray, *wa1.RealArray,
				*wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
	
	Declare func(chkder)(m.l, n.l, *x.RealArray, *fvec.RealArray, ldfjac.l, *xp.RealArray, *fvecp.RealArray,
				mode.l, *err.RealArray)
	
	Declare.r func(dpmpar)(i.l)
	Declare.r func(enorm)(n.l, *x.RealArray)
	
	; Compute a forward-difference approximation to the m by n jacobian
	; matrix associated with a specified problem of m functions in n
	; variables.
	Declare.l func(fdjac2)(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
				ldfjac.l, epsfcn.r, *wa.RealArray)
	
	; Compute a forward-difference approximation to the n by n jacobian
	; matrix associated with a specified problem of n functions in n
	; variables. If the jacobian has a banded form, then function
	; evaluations are saved by only approximating the nonzero terms.
	Declare.l func(fdjac1)(*fcn_mn.cminpack_func_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
				ldfjac.l, ml.l, mu.l, epsfcn.r, *wa1.RealArray, *wa2.RealArray)
	
	; Compute inverse(JtJ) after a run of lmdif or lmder. The covariance matrix is obtained
	; by scaling the result by enorm(y)**2/(m-n). If JtJ is singular and k = rank(J), the
	; pseudo-inverse is computed, and the result has to be scaled by enorm(y)**2/(m-k).
	Declare func(covar)(n.l, *r.RealArray, ldr.l, *ipvt.RealArray, tol.r, *wa.RealArray)
	
	; Covar1 estimates the variance-covariance matrix:
	;    C = sigma**2 (JtJ)**+
	;    where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
	;    and sigma**2 = fsumsq / (m - k)
	;    where fsumsq is the residual sum of squares and k is the rank of J.
	;    The function returns 0 if J has full rank, else the rank of J.
	Declare.l func(covar1)(m.l, n.l, fsumq.r, *r.RealArray, ldr.l, *ipvt.RealArray, tol.r, *wa.RealArray)
EndDeclareModule

Module CMinPack
	ImportC "-lcminpack"
		func(hybrd1).l(*fcn_nn.cminpack_func_nn, *p, n.l, *x.RealArray,*fvec.RealArray, tol.r, *wa.RealArray, lwa.l)
		
		func(hybrd).l(*fcn_nn.cminpack_func_nn, *p, n.l, *x.RealArray, *fvec.RealArray, xtol.r, maxfev.l, ml.l, mu.l,
			epsfcn.r, *diag.RealArray, mode.l, factor.r, nprint.l, *nfev.Long, *fjac.RealArray,
			ldfjac.l, *r.RealArray, lr.l, *qtf.RealArray, *wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
		
		func(hybrj1).l(*fcnder_nn.cminpack_funcder_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l,
			tol.l, *wa.RealArray, lwa.l)
		
		func(hybrj).l(*fcnder_nn.cminpack_funcder_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray, ldfjac.l,
			xtol.r, maxfev.l, *diag.RealArray, mode.l, factor.r, nprint.l, *nfev.Long, *njev.Long,
			*r.RealArray, lr.l, *qtf.RealArray, *wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
		
		func(lmdif1).l(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, tol.r,
			*iwa.Long, *wa.RealArray, lwa.l)
			
		func(lmdif).l(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, ftol.r,
			xtol.r, gtol.r, maxfev.l, epsfcn.r, *diag.RealArray, mode.l, factor.r,
			nprint.l, *nfev.Long, *fjac.RealArray, ldfjac.l, *ipvt.Long, *qtf.RealArray,
			*wa1.RealArray, *wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
		
		func(lmder1).l(*fcnder_mn.cminpack_funcder_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
			ldfjac.l, tol.r, *ipvt.Long, *wa.RealArray, lwa.l)
		
		func(lmder).l(*fcnder_mn.cminpack_funcder_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
			ldfjac.l, ftol.r, xtol.r, gtol.r, macfev.l, *diag.RealArray, mode.l, factor.r,
			nprint.l, *nfev.Long, *njev.Long, *ipvt.Long, *qtf.RealArray, *wa1.RealArray,
			*wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
		
		func(lmstr1).l(*fcnderstr_mn.cminpack_funcderstr_mn, *p, m.l, n.l, *x.RealArray,*fvec.RealArray, *fjac.RealArray,
			ldfjac.l, tol.r, *ipvt.Long, *wa.RealArray, lwa.l)
		
		func(lmstr).l(*fcnderstr_mn.cminpack_funcderstr_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
			ldfjac.l, ftol.r, xtol.r, gtol.r, maxfev.l, *diag.RealArray, mode.l, factor.r,
			nprint.l, *nfev.Long, *njev.Long, *ipvt.Long, *qtf.RealArray, *wa1.RealArray,
			*wa2.RealArray, *wa3.RealArray, *wa4.RealArray)
		
		func(chkder)(m.l, n.l, *x.RealArray, *fvec.RealArray, ldfjac.l, *xp.RealArray, *fvecp.RealArray,
			mode.l, *err.RealArray)
	
		func(dpmpar).r(i.l)
		func(enorm).r(n.l, *x.RealArray)
		
		func(fdjac2).l(*fcn_mn.cminpack_func_mn, *p, m.l, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
			ldfjac.l, epsfcn.r, *wa.RealArray)
		
		func(fdjac1).l(*fcn_mn.cminpack_func_nn, *p, n.l, *x.RealArray, *fvec.RealArray, *fjac.RealArray,
			ldfjac.l, ml.l, mu.l, epsfcn.r, *wa1.RealArray, *wa2.RealArray)
		
		func(covar)(n.l, *r.RealArray, ldr.l, *ipvt.RealArray, tol.r, *wa.RealArray)
		func(covar1).l(m.l, n.l, fsumq.r, *r.RealArray, ldr.l, *ipvt.RealArray, tol.r, *wa.RealArray)
	EndImport
EndModule

DeclareModule CMinPackWrapper
	UseModule CMinPackType
	
	Prototype.r fittingFunction(x.r, *coeff.RealArray)
	
	Structure ValuePair
		x.r
		y.r
	EndStructure
	
	Declare.i fit_lmdif(*fittingFunction.fittingFunction, Array observedValues.ValuePair(1), Array coeffs.r(1), tolerance.r, *quit.Integer = 0)
EndDeclareModule

Module CMinPackWrapper
	UseModule CMinPack

	Structure ValuePairArray
		v.ValuePair[0]
	EndStructure
	
	Structure CallbackData
		*values.ValuePairArray
		myFunction.fittingFunction
		*quit.Integer
	EndStructure
	
	Procedure.l callback_lmdif(*p.CallbackData, m.l, n.l, *x.RealArray, *fvec.RealArray, iflag.l)
		Protected i.i = 0
		
		While i < m
			*fvec\r[i] = *p\myFunction(*p\values\v[i]\x, *x) - *p\values\v[i]\y
			i + 1
		Wend
		
		ProcedureReturn Bool(*p\quit\i) * -1
	EndProcedure
	
	; Return codes (info):
	;  -1  Low memory.
	;   0  Improper input parameters.
	;   1  Algorithm estimates that the relative error in the sum of squares is at most tol.
	;   2  Algorithm estimates that the relative error between x and the solution is at most tol.
	;   3  Conditions for info = 1 and info = 2 both hold.
	;   4  fvec is orthogonal to the columns of the Jacobian to machine precision.
	;   5  Number of calls to fcn has reached or exceeded 200 * (n + 1).
	;   6  tol is too small. No further reduction in the sum of squares is possible.
	;   7  tol is too small. No further improvement in the approximate solution x is possible. 
	Procedure.i fit_lmdif(*fittingFunction.fittingFunction, Array observedValues.ValuePair(1), Array coeffs.r(1), tolerance.r, *quit.Integer = 0)
		Protected cbData.CallbackData
		Protected size.i = ArraySize(observedValues()) + 1
		Protected cCoeffs.i = ArraySize(coeffs()) + 1
		Protected info.i
		
		cbData\values = @observedValues()
		cbData\myFunction = *fittingFunction
		If (*quit)
			cbData\quit = *quit
		Else
			Protected fakeQuit.i = 0
			cbData\quit = @fakeQuit
		EndIf
		
		Protected lwa.i = size * cCoeffs + 5 * cCoeffs + size
		Protected *fvec = AllocateMemory((2 * size + lwa) * SizeOf(Real))
		If (Not *fvec)
			ProcedureReturn -1
		EndIf
		Protected *iwa = *fvec + size * SizeOf(Real)
		Protected *wa = *fvec + 2 * size * SizeOf(Real)
		
		Protected i.i = 0
		While i < cCoeffs
			coeffs(i) = 0
			i + 1
		Wend
		
		info = func(lmdif1)(@callback_lmdif(), @cbData, size, cCoeffs, @coeffs(), *fvec, tolerance, *iwa, *wa, lwa)
		
		FreeMemory(*fvec)
		
		ProcedureReturn info
	EndProcedure
EndModule

CompilerIf #PB_Compiler_IsMainFile
	
	#DEMO = 1

	EnableExplicit
	
	UseModule CMinPackType
	UseModule CMinPackWrapper
	
	CompilerSelect #DEMO
	
		CompilerCase 0:
	
			; Die Funktion, an die angefittet werden soll:
			;    f(a, b, c) = c · x² + b · x + a
			Procedure.r MyFittingFunction(x.r, *coeff.RealArray)
				ProcedureReturn *coeff\r[2] * x * x + *coeff\r[1] * x + *coeff\r[0]
			EndProcedure
			
			; Die zu ermittelnden Koeffizienten:
			;    coeffs(0) = a
			;    coeffs(1) = b
			;    coeffs(2) = c
			Dim coeffs.r(2)
			
			; Die Ausgangsdaten, die wir hier jetzt simulieren.
			; Wir nehmen an es wären insgesamt 200001 Datenpunkte gemessen worden.
			Dim observed.ValuePair(200000)
			Define i.i
			; Die Datenpunkte erstellen wir, indem wir die Koeffizienten wie folgt definieren
			; und zusätzlich noch einen Zufallswert zwischen -1 und 1 dazu rechnen:
			;    a = 3
			;    b = 2
			;    c = 0.5
			; Den x-Wert bewegen wir von -100000 bis 100000 in 0,01er-Schritten
			For i = 0 To 200000
				Define x.r = (i - 100000) * 0.01
				observed(i)\x = x
				; y = 0.5 · x² + 2 * x + 3 + rnd(-1, 1)
				observed(i)\y = 0.5 * x * x + 2 * x + 3 + ((Random(200) - 100.) / 100.)
			Next
			
			; Wir rufen die Fitting-Funktion aus dem Wrapper-Modul auf.
			Define.i time = ElapsedMilliseconds()
			Define.i info = fit_lmdif(@MyFittingFunction(), observed(), coeffs(), 1e-08)
			time = ElapsedMilliseconds() - time
			Debug "Exit Status: " + info
			Debug "Time: " + time + " ms"
			
			; Jetzt können wir die berechneten Koeffizienten ausgeben
			Debug "a = " + coeffs(0)
			Debug "b = " + coeffs(1)
			Debug "c = " + coeffs(2)
			
		CompilerCase 1
			#COEFFS = 5
			#WIDTH = 1000
			#HEIGHT = 800
			#TOLERANCE = 1e-03
			
			#REAL_WIDTH = 1.0
			#REAL_HEIGHT = 1.0
			
			Procedure.r MyFittingFunction(x.r, *coeff.RealArray)
				Protected result.r, i.i = 0
				While i < #COEFFS
					result * x
					result + *coeff\r[i]
					i + 1
				Wend
				ProcedureReturn result
			EndProcedure
			
			Dim observed.ValuePair(#WIDTH - 1)
			Dim coeffs.r(#COEFFS - 1)
			
			Define.i lock.i = CreateMutex()
			Define.i newValues.i = CreateSemaphore(0)
			Define.i cancelFit.i = #False
			
			#WINDOW_ID = 0
			#CANVAS_ID = 0
			#TIMER_ID = 0
			
			Procedure Draw()
				Protected x.i, y.i, draw.i
				Static leftButtonDown.i = #False
				Shared observed()
				Shared newValues, lock
				Static lastX.i
				Shared cancelFit
				
				x = GetGadgetAttribute(#CANVAS_ID, #PB_Canvas_MouseX)
				If (x < 0) : x = 0 : EndIf
				If (x >= #WIDTH) : x = #WIDTH - 1 : EndIf
				y = GetGadgetAttribute(#CANVAS_ID, #PB_Canvas_MouseY)
				
				Select EventType()
					Case #PB_EventType_LeftButtonDown
						leftButtonDown = #True
						draw = #True
						lastX = x
					Case #PB_EventType_LeftButtonUp
						leftButtonDown = #False
					Case #PB_EventType_MouseMove
						If (leftButtonDown)
							draw = #True
						EndIf
				EndSelect
				
				If (draw)
					Protected dir.i = Bool(lastX < x) * 2 - 1
					If (lastX = x) : dir = 0 : EndIf
					cancelFit = #True
					LockMutex(lock)
					Repeat
						observed(lastX)\y = #REAL_HEIGHT * y / #HEIGHT
						lastX + dir
					Until lastX = x
					
					If (Not TrySemaphore(newValues))
						SignalSemaphore(newValues)
					EndIf
					UnlockMutex(lock)
				EndIf
			EndProcedure
			
			Macro clamp(var, min, max)
				If (var < min) : var = min : EndIf
				If (var > max) : var = max : EndIf
			EndMacro
			
			Procedure fitThread(*quit.Integer)
				Shared lock, newValues
				Shared observed()
				Shared coeffs()
				Shared cancelFit
				
				While Not *quit\i
					LockMutex(lock)
					cancelFit = #False
 					If (fit_lmdif(@MyFittingFunction(), observed(), coeffs(), #TOLERANCE, @cancelFit) > 0)
 						;Fehler
 					EndIf
 					UnlockMutex(lock)
 					WaitSemaphore(newValues)
				Wend
			EndProcedure
			
			Define.i quitThread = #False
			Define thread.i
			Procedure quitFitThread()
				Shared quitThread, cancelFit, newValues, thread
				quitThread = #True
				cancelFit = #True
				SignalSemaphore(newValues)
				
				WaitThread(thread)
			EndProcedure
			
			Procedure refreshCanvas()
				Shared observed(), coeffs(), lock

				If StartDrawing(CanvasOutput(#CANVAS_ID))
					Box(0, 0, #WIDTH, #HEIGHT, $ffffff)
					Protected lastY.r, x.i, y.r
					
					For x = 0 To #WIDTH - 1
						y = observed(x)\y * #HEIGHT / #REAL_HEIGHT
						If (x > 0)
							LineXY(x - 1, lastY, x, y, $000000)
						EndIf
						lastY = y
					Next
					
					For x = 0 To #WIDTH - 1
						y = MyFittingFunction(observed(x)\x, @coeffs()) * #HEIGHT / #REAL_HEIGHT
						If (x > 0)
							LineXY(x - 1, lastY, x, y, $ff0000)
						EndIf
						lastY = y
					Next
					
					StopDrawing()
				EndIf
			EndProcedure
			
			Procedure initObserved()
				Shared observed()
				Protected x.i
				
				For x = 0 To #WIDTH - 1
					observed(x)\x = x * #REAL_WIDTH / #WIDTH
					observed(x)\y = 0.5 * #REAL_HEIGHT
				Next
			EndProcedure
			
			If Not OpenWindow(#WINDOW_ID, 0, 0, #WIDTH, #HEIGHT, "CMinPack Demo", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
				End
			EndIf
			If Not CanvasGadget(#CANVAS_ID, 0, 0, #WIDTH, #HEIGHT)
				End
			EndIf
			BindGadgetEvent(#CANVAS_ID, @Draw())
			
			initObserved()
			
			thread = CreateThread(@fitThread(), @quitThread)
			ThreadPriority(thread, 8)
			
			AddWindowTimer(#WINDOW_ID, #TIMER_ID, 100)
			
			Repeat
				Define event.i = WaitWindowEvent()
				Select event
					Case #PB_Event_CloseWindow
						Break
					
					Case #PB_Event_Timer
						If (EventTimer() = #TIMER_ID)
							refreshCanvas()
						EndIf
				EndSelect

			ForEver
			
			quitFitThread()
			
	CompilerEndSelect
CompilerEndIf