jackknife.bas

Surfer是地学中常用的一个软件

'Jackknife.bas grids the data set n times, leaving one of the data points out
' each time.  Also known as cross-validation. TB - 09 Aug 00.
Sub Main
	Debug.Print "----- ";Time;" -----"

	On Error Resume Next
  Set Surf = GetObject(, "Surfer.Application")
  If Err Then
  	'Don't clear Err so new errors will stop script execution.
    Err.Clear  
    Set Surf = CreateObject("Surfer.Application")
    surf.Documents.Add(srfDocPlot)	
    If Err Then
      MsgBox Err.Description
      Exit Sub
    End If
  End If

	surf.Visible = True
	Set plotdoc1 = surf.Documents("Plot1")
	Set plotwin1 = surf.Windows("Plot1:1")
	path1 =surf.Path+"\samples\"

	datafile1 = GetFilePath("demogrid.dat", _
		"dat;xls", _
		path1, _
		"Get Data File", _
		0)
		
	Set shapes1 = plotdoc1.Shapes
	'surf.Open datafile1
	Set wksdoc1 = surf.Documents.Open(datafile1)
	'Set range from column A to C.
	Set xyrange = wksdoc1.Columns(col1:=1, col2:=3)
	Set xystats = xyrange.Statistics 
	'Attempt to skip header row and find first data row.
	With xystats
		firstrow = .FirstRow
		While Val(wksdoc1.Cells(firstrow,1)) = 0 And _
		 Trim(wksdoc1.Cells(firstrow,1)) <> "0"
			firstrow=firstrow+1
		Wend
		lastrow = .LastRow
		xmin = .Minimum
		xmax = .Maximum
		ymin = .Minimum(2)
		ymax = .Maximum(2)
	End With
	
	Debug.Print firstrow;lastrow;xmin;xmax;ymin;ymax
		
	surf.GridData(datafile1, outgrid:= path1 + "file1.grd", _
		showreport := False, _
		algorithm:=srfKriging)
	
	'Add header to column D.
	wksdoc1.Cells(1,4)="Jackknife"
	'Grid with exclusion filter.  
	'Expand grid by 1.0 data unit so edges aren't blanked.
	For i = firstrow To lastrow
		x1 = wksdoc1.Cells(i,1)
		y1 = wksdoc1.Cells(i,2)
		exclusionstring = "x = " + x1 + " and y = " + y1
		surf.GridData(datafile1, _
			algorithm:=srfKriging, _
			exclusionfilter := exclusionstring, _
			outgrid := path1 + "temp.grd", _
			showreport := False, _
			xMin:=xmin-1, xMax:=xmax+1, yMin:=ymin-1, yMax:=ymax+1)
		Set grid1 = surf.NewGrid
		grid1.LoadFile(path1 + "temp.grd", False)
		wksdoc1.Cells(i,4) = grid1.Interpolate(Val(x1),Val(y1))
		
		jackdiff = wksdoc1.Cells(i,3) - wksdoc1.Cells(i,4)
		sumsquares = sumsquares + (jackdiff * jackdiff)
		For j = 1 To 4
			Debug.Print wksdoc1.Cells(i,j);" ";
		Next j
		Debug.Print ""
	Next i
	Debug.Print "Sum of Squares of Differences = ";sumsquares	
End Sub