Place Exceptions.fh_lua

--[[
@Title:			Place Exceptions
@Type:				Standard
@Author:			Mike Tate
@Version:			1.2
@Keywords:		
@LastUpdated:	13 Jan 2023
@Licence:			This plugin is copyright (c) 2023 Mike Tate and contributors, and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description:	Find the Place records that may have geocoded incorrectly or have place name abnormalities.
@V1.2:				Cater for unmatched ( in Place name parts; Fix for NaN values in Distance & Bearing calculations;
@V1.1:				FindVariantParts() uses intVmax for both number tests; intVmax default = 1 and max = 3; Use fixed utf8.lower(); Fix Check Version in Store;
@V1.0:				First published version;
]]

local StrVersion = "1.2"													-- Update when version changes

require("iuplua")															-- To access GUI window builder for iup.GetParam()
require("lfs")																-- To access Lua File System for LoadUserParams()

iup.SetGlobal("CUSTOMQUITMESSAGE","YES")								-- Needed for IUP 3.28

local intVmax = 1															-- Max number of Variance places threshold 
local intPmax = 2															-- Number of rightmost place parts to analyse
local numSdev = 2.00														-- Standard deviation variance threshold
local intTest = 1															-- Number of rightmost place parts for single plot test

local Deg2Rad = math.pi / 180											-- Degrees to Radians multiplier
local arrType = { "Singleton"; "Plot Pair"; "Deviation"; "Similarity"; "Variance"; }
local arrSect = { " ~ NW-N"; " ~ W-NW"; " ~ SW-W"; " ~ S-SW"; " ~ SE-S"; " ~ E-SE"; " ~ NE-E"; " ~ N-NE"; }
local intSmax = #arrSect													-- Number of place angular sectors to analyse
local radSect = 360 * Deg2Rad / intSmax								-- Radians per angular sector

local intNone = 0															-- Count places with no Lat/Long 
local setRec  = {}															-- Result set tables
local setRid  = {}
local setStan = {}
local setSort = {}
local setType = {}
local setSdev = {}
local setArea = {}

--[[
@Module:			+fh+stringx_v3
@Author:			Mike Tate
@Version:			3.0
@LastUpdated:	19 Sep 2020
@Description:	Extended string functions to supplement LUA string library.
@V3.0:				Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility; Added inert(strTxt) function;
@V2.5:				Support FH V6 Encoding = UTF-8;
@V2.4:				Tolerant of integer & nil parameters just link match & gsub;
@V1.0:				Initial version.
]]

local function stringx_v3()

	local fh = {}									-- Local environment table

	-- Supply current file encoding format --
	function fh.encoding()
		if fhGetAppVersion() > 5 then return fhGetStringEncoding() end
		return "ANSI"
	end -- function encoding

	-- Split a string using "," or chosen separator --
	function fh.split(strTxt,strSep)
		local tblFields = {}
		local strPattern = string.format("([^%s]+)", strSep or ",")
		strTxt = tostring(strTxt or "")
		strTxt:gsub(strPattern, function(strField) tblFields[#tblFields+1] = strField end)
		return tblFields
	end -- function split

	-- Split a string into numbers using " " or "," or "x" separators	-- Any non-number remains as a string
	function fh.splitnumbers(strTxt)
		local tblNum = {}
		strTxt = tostring(strTxt or "")
		strTxt:gsub("([^ ,x]+)", function(strNum) tblNum[#tblNum+1] = tonumber(strNum) or strNum end)
		return tblNum
	end -- function splitnumbers

	local strMagic = "([%^%$%(%)%%%.%[%]%*%+%-%?])"							-- UTF-8 replacement for "(%W)"

	-- Hide magic pattern symbols	^ $ ( ) % . [ ] * + - ?
	function fh.plain(strTxt)
		-- Prefix every magic pattern character with a % escape character,
		-- where %% is the % escape, and %1 is the original character capture.
		strTxt = tostring(strTxt or ""):gsub(strMagic,"%%%1")
		return strTxt
	end -- function plain

	-- matches is plain text version of string.match()
	function fh.matches(strTxt,strFind,intInit)
		strFind = tostring(strFind or ""):gsub(strMagic,"%%%1")			-- Hide magic pattern symbols
		return tostring(strTxt or ""):match(strFind,tonumber(intInit))
	end -- function matches

	-- replace is plain text version of string.gsub()
	function fh.replace(strTxt,strOld,strNew,intNum)
		strOld = tostring(strOld or ""):gsub(strMagic,"%%%1")				-- Hide magic pattern symbols
		return tostring(strTxt or ""):gsub(strOld,function() return strNew end,tonumber(intNum))	-- Hide % capture symbols
	end -- function replace

	-- Hide % escape/capture symbols in replacement so they are inert
	function fh.inert(strTxt)
		strTxt = tostring(strTxt or ""):gsub("%%","%%%%")					-- Hide all % symbols
		return strTxt
	end -- function inert

	-- convert is pattern without captures version of string.gsub()
	function fh.convert(strTxt,strOld,strNew,intNum)
		return tostring(strTxt or ""):gsub(tostring(strOld or ""),function() return strNew end,tonumber(intNum))	-- Hide % capture symbols
	end -- function convert

	local dicUpper = { }
	local dicLower = { }
	local dicCaseX = { }
	-- ASCII unaccented letter translations for Upper, Lower, and Case Insensitive
	for intUpper = string.byte("A"), string.byte("Z") do
		local strUpper = string.char(intUpper)
		local strLower = string.char(intUpper - string.byte("A") + string.byte("a"))
		dicUpper[strLower] = strUpper
		dicLower[strUpper] = strLower
		local strCaseX = "["..strUpper..strLower.."]"
		dicCaseX[strLower] = strCaseX
		dicCaseX[strUpper] = strCaseX
	end

	-- Supply character length of ANSI text --
	function fh.length(strTxt)
		return string.len(strTxt or "")
	end -- function length

	-- Supply character substring of ANSI text --
	function fh.substring(strTxt,i,j)
		return string.sub(strTxt or "",i,j)
	end -- function substring

	-- Translate upper/lower case ANSI letters to pattern that matches both --
	function fh.caseless(strTxt)
		strTxt = tostring(strTxt or ""):gsub("[A-Za-z]",dicCaseX)
		return strTxt
	end -- function caseless

	if fh.encoding() == "UTF-8" then

		-- Supply character length of UTF-8 text --
		function fh.length(strTxt)
			isFlag = fhIsConversionLossFlagSet()
			strTxt = fhConvertUTF8toANSI(strTxt or "")
			fhSetConversionLossFlag(isFlag)
			return string.len(strTxt)
		end -- function length

		local strUTF8 = "([%z\1-\127\194-\244][\128-\191]*)"			-- Cater for Lua 5.1 %z or Lua 5.3 \0
		if fhGetAppVersion() > 6 then
			strUTF8 = "([\0-\127\194-\244][\128-\191]*)"
		end

		-- Supply character substring of UTF-8 text --
		function fh.substring(strTxt,i,j)
			local strSub = ""
			j = j or -1
			if j < 0 then j = j + length(strTxt) + 1 end
			if i < 0 then i = i + length(strTxt) + 1 end
			for strChr in string.gmatch(strTxt or "",strUTF8) do
				if j <= 0 then break end
				j = j - 1
				i = i - 1
				if i <= 0 then strSub = strSub..strChr end
			end
			return strSub
		end -- function substring

		-- Translate lower case to upper case UTF-8 letters --
		function fh.upper(strTxt)
			strTxt = tostring(strTxt or ""):gsub("([a-z\194-\244][\128-\191]*)",dicUpper)
			return strTxt
		end -- function upper

		-- Translate upper case to lower case UTF-8 letters --
		function fh.lower(strTxt)
			strTxt = tostring(strTxt or ""):gsub("([A-Z\194-\244][\128-\191]*)",dicLower)
			return strTxt
		end -- function lower

		-- Translate upper/lower case UTF-8 letters to pattern that matches both --
		function fh.caseless(strTxt)
			strTxt = tostring(strTxt or ""):gsub("([A-Za-z\194-\244][\128-\191]*)",dicCaseX)
			return strTxt
		end -- function caseless

		-- Following tables use ASCII numeric coding to be immune from ANSI/UTF-8 encoding --

		local arrPairs =	-- Upper & Lower case groups of UTF-8 letters with same prefix --
		{--	{ Prefix; Beg ; End ; Inc; Offset Upper > Lower };			-- These include all ANSI letters and many more
			{ "\195"; 0x80; 0x96;  1 ; 32 };								-- 195=0xC3 À U+00C0 to Ö U+00D6 and à U+00E0 to ö U+00F6
			{ "\195"; 0x98; 0x9E;  1 ; 32 };								-- 195=0xC3 Ø U+00D8 to Þ U+00DE and ø U+00F8 to þ U+00FE
			{ "\196"; 0x80; 0xB6;  2 ;  1 };								-- 196=0xC4 A U+0100 to k U+0137 in pairs
			{ "\196"; 0xB9; 0xBD;  2 ;  1 };								-- 196=0xC4 L U+0139 to l U+013E in pairs
			{ "\197"; 0x81; 0x87;  2 ;  1 };								-- 197=0xC5 L U+0141 to n U+0148 in pairs
			{ "\197"; 0x8A; 0xB6;  2 ;  1 };								-- 197=0xC5 ? U+014A to y U+0177 in pairs
			{ "\197"; 0xB9; 0xBD;  2 ;  1 };								-- 197=0xC5 Z U+0179 to ž U+017E in pairs
			{ "\198"; 0x82; 0x84;  2 ;  1 };								-- 198=0xC6 ?  U+0182 to ?  U+0185 in pairs
			-- Add more Unicode groups here as usage increases --
		}
		local dicPairs =	-- Upper v Lower case UTF-8 letters that don't fit groups above --
		{	[string.char(0xC4,0xBF)] = string.char(0xC5,0x80);			-- ? U+013F and ? U+0140
			[string.char(0xC5,0xB8)] = string.char(0xC3,0xBF);			-- Ÿ U+0178 and ÿ U+00FF
		}

		local intBeg1 = string.byte(string.sub("À",1))
		local intBeg2 = string.byte(string.sub("À",2))
		local intEnd1 = string.byte(string.sub("Z",1))
		local intEnd2 = string.byte(string.sub("Z",2))
	--	print(string.format("%#x %#x %#x %#x",intBeg1,intBeg2,intEnd1,intEnd2)) -- Useful to work out numeric coding

		-- Populate the UTF-8 letter translation dictionaries --
		for intGroup, tblGroup in ipairs ( arrPairs ) do				-- UTF-8 accented letter groups
			local strPrefix = tblGroup[1]
			for intUpper = tblGroup[2], tblGroup[3], tblGroup[4] do
				local strUpper = string.char(intUpper)
				local strLower = string.char(intUpper + tblGroup[5])
				local strCaseX = strPrefix.."["..strUpper..strLower.."]"
				strUpper = strPrefix..strUpper
				strLower = strPrefix..strLower
				dicUpper[strLower] = strUpper
				dicLower[strUpper] = strLower
				dicCaseX[strLower] = strCaseX
				dicCaseX[strUpper] = strCaseX
			end
		end
		for strUpper, strLower in pairs ( dicPairs ) do					-- UTF-8 accented letters where upper & lower have different prefix
			dicUpper[strLower] = strUpper
			dicLower[strUpper] = strLower
			local strCaseX = ""
			for intByte = 1, #strUpper do									-- Matches more than just the two letters, but can't do any better
				strCaseX = strCaseX.."["..strUpper:sub(intByte,intByte)..strLower:sub(intByte,intByte).."]"
			end
			dicCaseX[strLower] = strCaseX
			dicCaseX[strUpper] = strCaseX
		end

	end -- fh.encoding() == "UTF-8"

	-- overload fh functions into string table
	for strIndex, anyValue in pairs(fh) do
		if type(anyValue) == "function" then
			string[strIndex] = anyValue
		end
	end

	return fh

end -- local function stringx_v3

local stringx = stringx_v3()													-- To access FH string extension module


function SaveToResultSet(tblRecd,intRid,intSect,numSdev)			-- Report exceptional record found
	local ptrRec = tblRecd.Recd
	if tblRecd.Incl and not fhCallBuiltInFunction("IsInList",ptrRec,"Place Exceptions") then
		local intType = tblRecd.Type
		local strType = arrType[intType]
		local strSect = arrSect[intSect] or " "
		local strSdev = "~"
		if intType == 3 then
			strSdev = string.format("%4s",tostring(numSdev))
		end
		table.insert(setRec ,ptrRec:Clone())
		table.insert(setRid ,intRid)
		table.insert(setStan,fhGetItemText(ptrRec,"~.STAN"))
		table.insert(setSort,intType)
		table.insert(setType,strType)
		table.insert(setSdev,strSdev)
		table.insert(setArea,tblRecd.Area..strSect)
	end
end -- function SaveToResultSet

function OutputResultSet()												-- Produce result set
	if #setRec > 0 then
		fhOutputResultSetTitles("Place Exceptions  "..StrVersion)
		fhOutputResultSetColumn("Place Record", "item", setRec , #setRec, 200, "align_left", 3, true, "default" )
		fhOutputResultSetColumn("RecId"    , "integer", setRid , #setRec,  30, "align_mid" )
		fhOutputResultSetColumn("Standardized", "text", setStan, #setRec, 200, "align_left")
		fhOutputResultSetColumn("Sort"     , "integer", setSort, #setRec,  30, "align_left", 1, false, "integer", "hide" )
		fhOutputResultSetColumn("Type"     , "text"   , setType, #setRec,  40, "align_left")
		fhOutputResultSetColumn("St.Dev."  , "text"   , setSdev, #setRec,  30, "align_mid" )
		fhOutputResultSetColumn("Area"     , "text"   , setArea, #setRec, 300, "align_left", 2, true )
	else
		fhMessageBox("\n No place exceptions found. \n "..intNone.." places have no Lat/Longitude \n")
	end
end -- function OutputResultSet

function GetFileName()														-- Get user params filename
	local strName = ""
	if fhGetContextInfo("CI_APP_MODE") == "Project Mode" then
		strName = fhGetPluginDataFileName()								-- Use Project sticky options
	else
		strName = fhGetPluginDataFileName("LOCAL_MACHINE")			-- Use global sticky options needs V5.0.8
	end
	strName = strName:gsub(" %- V%d.*%.dat$",".dat")				-- Use same .dat file for all Plugin versions
	return fhConvertUTF8toANSI(strName)
end -- function GetFileName

function LoadUserParams()													-- Load user params from file
	local strFileName = GetFileName() or "?"
	if lfs.attributes(strFileName,"mode") == "file" then			-- Read the file in table lines
		local dicOption = {}
		for strLine in io.lines(strFileName) do
			local arrFields = {}
			strLine:gsub("([^=]+)", function(strField) arrFields[#arrFields+1] = strField end)
			dicOption[arrFields[1]] = tonumber(arrFields[2])
		end
		intVmax = dicOption["Vmax"]
		intPmax = dicOption["Pmax"]
		numSdev = dicOption["Sdev"]
		intTest = dicOption["Test"]
	end
end -- function LoadUserParams

function SaveUserParams()													-- Save user params into file
	local strFileName = GetFileName() or "?"
	local fileHandle = io.open(strFileName,"w")
	if fileHandle then
		fileHandle:write("Vmax="..tostring(intVmax).."\n")
		fileHandle:write("Pmax="..tostring(intPmax).."\n")
		fileHandle:write("Sdev="..tostring(numSdev).."\n")
		fileHandle:write("Test="..tostring(intTest).."\n")
		fileHandle:close()
	end
end -- function SaveUserParams

function paramAction(iupDialog,intIndex)
	if intIndex == iup.GETPARAM_MAP then								-- Correct button labels needed for IUP 3.28 bug
		iupDialog.Button1.Title = " Review Places "
		iupDialog.Button2.Title = " Close Plugin "
	elseif intIndex == (iup.GETPARAM_HELP or -4) then				-- FH V5 needs -4
		fhShellExecute("https://pluginstore.family-historian.co.uk/page/help/place-exceptions","","","open")
		fhSleep(3000,500)
		iupDialog.BringFront="YES"
	end
	return 1
end -- function paramAction

function GetUserParams()													-- Prompt for Place Parts and Std Dev parameters
	local tblForm = {}
	table.insert(tblForm," Variance Usage Threshold  %i[0,3,1]{ Maximum usage of a name to qualify for Variance exceptions }")
	table.insert(tblForm," Rightmost Place Parts     %i[0,4,1]{ Maximum number of rightmost place parts to form cluster areas }")
	table.insert(tblForm," Standard Deviations       %r[1,4,0.1]{ Deviance sensitivity for the geocode plot outlier exceptions }")
	table.insert(tblForm," Low Usage Place Parts     %i[0,4,1]{ Righthand place parts to check for Plot Pair/Singleton exceptions }")
	table.insert(tblForm,"%u[ Review Places , Close Plugin , Help && Advice ]\n")
	return iup.GetParam("Family Historian - Place Exceptions  "..StrVersion, paramAction, table.concat(tblForm,"\n"), intVmax, intPmax, numSdev, intTest)
end -- function GetUserParams

local tblVary = {}

function SaveVariantParts(strTidy)										-- Save variants of place parts to find abnormal spellings
	local dicVary = {}
	for strPart in strTidy:gmatch(" ?([^,]+)") do					-- Loop through each comma separated place part
		local strTail = strTidy:match(strPart:gsub("(%p)","%%%1").."(, .+)$") or ""	-- V1.2
		local strName = strPart..strTail								-- Append the righthand parts to establish context
		if tblVary[strName] then
			tblVary[strName].Num = tblVary[strName].Num + 1			-- Count each occurrence of this place name
			if tblVary[strName].Sift then
				for strSift, _ in pairs (tblVary[strName].Sift) do	-- Handle all place names with this name as a variant
					if tblVary[strSift].Part and not tblVary[strSift].Part[strName] then
						tblVary[strSift].Num = tblVary[strSift].Num + 1
						tblVary[strSift].Part[strName] = true
					end
				end
			end
		else
			local intLen = utf8.len(strPart)							-- Compute the variants of this place name
			local arrChar = {}
			local dicSift = {}
			for _, intCode in utf8.codes(strPart) do
				table.insert(arrChar,utf8.char(intCode))				-- Tabulate each UTF-8 character in lefthand place part
			end
			if intLen > 1 then
				for intPos = 1, intLen do									-- Compute each variant by removing one character at a time
					local strChar, strSift
					strChar = table.remove(arrChar,intPos)
					strSift = table.concat(arrChar)..strTail			-- Append the righthand parts and save variant
					if not dicSift[strSift] then
						dicSift[strSift] = true
						if not tblVary[strSift] then
							tblVary[strSift] = { Num=0; Part={}; Sift={}; }
						end
						if tblVary[strSift].Part then					-- Update occurrence count
							if not tblVary[strSift].Part[strName] then
								tblVary[strSift].Num = tblVary[strSift].Num + 1
							end
							tblVary[strSift].Part[strName] = true
						end
					end
					table.insert(arrChar,intPos,strChar)				-- Put removed character back
				end
			end
			tblVary[strName] = { Num=1; Part={}; Sift=dicSift; }	-- Save unadulterated place name details
		end
		if not dicVary[strName] then
			dicVary[strName] = true
		end
	end
	return dicVary															-- List of all place names for Place record table
end -- function SaveVariantParts

function FindVariantParts(tblRec)										-- Find place name abnormal spellings
	for intRid, tblRecd in pairs (tblRec) do
		for strName, _ in pairs (tblRecd.Vary) do						-- Check each place name
			if tblVary[strName].Num <= intVmax then
				for strSift, _ in pairs (tblVary[strName].Sift) do	-- Only occurs a few times so check each variant	-- V1.1
					local dicVary = tblVary[strSift]
					if dicVary.Num > intVmax then						-- Variant matches more occurrences so probable mispelling found	-- V1.1
						local arrPart = {}
						if dicVary.Part then
							for strPair, _ in pairs (dicVary.Part) do
								if strPair ~= strName then
									strPair = strPair:match("^([^,]+)")
									table.insert(arrPart,strPair)		-- Note the other leading place parts that match variant
								end
							end
						end
						if #arrPart == 0 then
							strSift = strSift:match("^([^,]+)")
							table.insert(arrPart,strSift)				-- If none then leading place part equals the variant
						end
						local strArea = strName:match("^([^,]+)")		-- Leading place name part
						tblRecd.Type = 5									-- Report the Variant abnormality
						tblRecd.Area = strArea.."  ~  "..table.concat(arrPart,"; ")
						SaveToResultSet(tblRecd,intRid,0)
						tblRecd.Incl = false								-- Inhibit it in future Variance or Similarity reports
						break
					end
				end
			end
		end
		collectgarbage("step",0)											-- Improve run time
	end
	tblVary = {}																-- Recover memory
end -- function FindVariantParts

function Main()
	local tblRec  = {}														-- Holds place record details
	local tblCal  = {}														-- Holds place calculations
	local dicTidy = {}														-- Holds tidied place names

	LoadUserParams()
	isOK, intVmax, intPmax, numSdev, intTest = GetUserParams()	-- Get user adjustable parameters
	if not isOK then return end
	SaveUserParams()

	local ptrRec = fhNewItemPtr()
	ptrRec:MoveToFirstRecord("_PLAC")									-- Loop through place records
	while ptrRec:IsNotNull() do
		local intRid = fhGetRecordId(ptrRec)
		local arrPart = {}													-- Holds place name part areas
		local strPart = ""
		local strText = fhGetItemText(ptrRec,"~.TEXT")
		local strStan = fhGetItemText(ptrRec,"~.STAN")
		local strName = strStan											-- Prefer Standardized name over Place Text name
		if strName == "" then strName = strText end

		for intPart = 1, 4 do -- intPmax do										-- Compile rightmost parts of place name
			strPart = strPart..fhCallBuiltInFunction("TextPart",strName,-intPart,1,"TIDY")..", "
			table.insert(arrPart,(strPart:gsub(", $","")))			-- Remove trailing comma & space
		end

		tblRec[intRid] = {													-- Save place record details
			Recd = ptrRec:Clone();
			Name = strText;
			Part = arrPart;
			Vary = {};
			Lati = tonumber(fhGetItemText(ptrRec,"~.LATLONG:LAT_NUMERIC"));
			Long = tonumber(fhGetItemText(ptrRec,"~.LATLONG:LONG_NUMERIC"));
			Dist = 0.1;														-- Distance from centre lat/long for similar place names
			Type = 0 ;														-- 0=Unknown, 1=Single, 2=Couple, 3=Multiple, 4=Similar, 5=Variant
			Area = "";														-- Relevant mode part area
			Incl = true;														-- Include in reports
		}
		local tblRecd = tblRec[intRid]
		local strTidy = utf8.lower(fhCallBuiltInFunction("TextPart",strText,1,0,"TIDY")):gsub(" +([ ,])","%1")	-- gsub fixes FH v6 TextPart bug
		local intTidy = dicTidy[strTidy]
		if intTidy then														-- Found identical tidied name so report both records
			local tblTidy = tblRec[intTidy]
			local strArea = tblRecd.Part[3].."  ..."					-- Obtain small area name and append ellipsis
			tblTidy.Type = 4
			tblTidy.Area = strArea
			SaveToResultSet(tblTidy,intTidy,0)
			tblRecd.Type = 4
			tblRecd.Area = strArea
			SaveToResultSet(tblRecd,intRid ,0)
		else
			dicTidy[strTidy] = intRid										-- Save Place Record Id against tidied name
		end

		tblRecd.Vary = SaveVariantParts(fhCallBuiltInFunction("TextPart",strText..", "..strStan,1,0,"TIDY"):gsub(" +([ ,])","%1"))
--	or?	tblRecd.Vary = SaveVariantParts(fhCallBuiltInFunction("TextPart",strName,1,0,"TIDY"):gsub(" +([ ,])","%1"))

		local degLati = tblRecd.Lati										-- Obtain lat/long field values
		local degLong = tblRecd.Long
		if degLati and degLong then
			tblRecd.Lati = degLati * Deg2Rad							-- Convert lat/long degrees to radians
			tblRecd.Long = degLong * Deg2Rad
			for intPart = 1, intPmax do									-- Compile values for similar place part areas
				local strArea = tblRecd.Part[intPart]
				local intCalc = tblCal[strArea] or #tblCal+1			-- Determine array index for area
				local tblCalc = tblCal[intCalc] or { Part=intPart; Area=strArea; Lati=0; Long=0; Rid={}; Sect={}; }
				tblCalc.Lati = tblCalc.Lati + tblRecd.Lati			-- Sum their lat/long values needed to compute centre 
				tblCalc.Long = tblCalc.Long + tblRecd.Long
				table.insert(tblCalc.Rid,intRid)						-- Save their Record Id
				if #tblCalc.Sect == 0 then
					for intSect = 0, intSmax do							-- Initialise each sector of values
						tblCalc.Sect[intSect] = { Rid={}; Dist={}; Kms=0; }
					end
				end
				tblCal[intCalc] = tblCalc									-- Update array of calculations
				tblCal[strArea] = intCalc									-- Cross-ref place part area to array index
			end
		else
			intNone = intNone + 1											-- Count missing Lat/Long
		end

		ptrRec:MoveNext()
		collectgarbage("step",0)											-- Improve run time
	end
	table.sort(tblCal,function(a,b) return #a.Area>#b.Area end)	-- Sort values with smallest areas first and largest areas last

	FindVariantParts(tblRec)

	for _, tblCalc in ipairs (tblCal) do								-- Analyse details for similar place areas starting with smallest areas
		local intPart = tblCalc.Part
		local strArea = tblCalc.Area
		local intRecs = #tblCalc.Rid
		if intRecs > 1 then 												-- Compute centre lat/long for similar areas
			tblCalc.Lati = tblCalc.Lati / intRecs
			tblCalc.Long = tblCalc.Long / intRecs
		end
		for _, intRid in ipairs (tblCalc.Rid) do						-- Compute distance from centre of similar areas
			local tblRecd = tblRec[intRid]
			if intRecs <= 2 then											-- Avoid complex formula only needed for multiple points
				if intPart <= intTest then -- and tblRecd.Incl then
					tblRecd.Type = intRecs									-- Single or Couple of records in this area
					tblRecd.Area = strArea
					SaveToResultSet(tblRecd,intRid,0)
					tblRecd.Incl = false									-- Exclude this place from later exception reports
				end
			else
				local radLat1 = tblCalc.Lati								-- See Aviation Formulary V1.47 https://edwilliams.org/avform147.htm
				local radLat2 = tblRecd.Lati
				local radLon1 = tblCalc.Long								-- Compute greate circle radians between points {radLat1,radLon1} and {radLat2,radLon2}
				local radLon2 = tblRecd.Long
				local radDist = 2*math.asin(math.sqrt((math.sin((radLat1-radLat2)/2))^2+math.cos(radLat1)*math.cos(radLat2)*(math.sin((radLon1-radLon2)/2))^2))
				local kmsDist = radDist * 6370							-- Convert radians to kilometres using earth radius
				local radBear = 0
				if kmsDist > 0.001 then									-- Compute course bearing between those points {radLat1,lon1} and {radLat2,radLon2} if more than a metre apart -- V1.2
					radBear = math.acos((math.sin(radLat2)-math.sin(radLat1)*math.cos(radDist))/(math.sin(radDist)*math.cos(radLat1)))
					if math.sin(radLon2-radLon1)>=0 then
						radBear = 2*math.pi-radBear
					end
					if radBear ~= radBear then radBear = 0 end		-- Detect and fix NaN -- V1.2
				end
				local intSect = math.min(7,math.floor(radBear/radSect))+1 -- Limit intSect to 8 -- V1.2
				local tblSect = tblCalc.Sect[intSect]					-- Update this sector

				if not tblSect then 										-- Failsafe error detection	-- V1.2
					local strMsg = "\n"
					for _, intRid in ipairs (tblCalc.Rid) do
						strMsg = strMsg.."\nintRid \t = "..intRid.."\t "..tblRec[intRid].Name
					end
					fhMessageBox("\nDistance & Bearing calculation error ~ please report to author\nintRid \t = "..intRid.."\t "..tblRec[intRid].Name.."\n Lati \t = "..tblRec[intRid].Lati.."\n Longi\t = "..tblRec[intRid].Long.."\nradBear\t = "..radBear.."\nradSect\t = "..radSect.."\nintSect\t = "..intSect..strMsg)
				end

				table.insert(tblSect.Rid,intRid)
				table.insert(tblSect.Dist,kmsDist)
				tblSect.Kms = tblSect.Kms + kmsDist						-- Sum the distances needed to compute mean

				local tblSect = tblCalc.Sect[0]							-- Update entire area
				table.insert(tblSect.Rid,intRid)
				table.insert(tblSect.Dist,kmsDist)
				tblSect.Kms = tblSect.Kms + kmsDist						-- Sum the distances needed to compute mean

				if tblRecd.Type ~= 3 then
					if tblRecd.Type > 0 then								-- Conteract Single/Couple mode exclusions
						tblRecd.Incl = true	
					end
					tblRecd.Dist = kmsDist
					tblRecd.Type = 3										-- Multiple records in this place area
					tblRecd.Area = strArea
				end
			end
		end
		if intRecs > 2 then
			for intSect = intSmax, 0, -1 do								-- Check each sector area then entire area last
				local tblSect = tblCalc.Sect[intSect]
				local intRecs = #tblSect.Rid
				if intRecs > 2 then
					local kmsMean = tblSect.Kms / intRecs				-- Mean of distances from centre of sector area
					local sumSqrs = 0
					for _, kmsDist in ipairs (tblSect.Dist) do		-- Compute standard deviation of those distances from mean
						sumSqrs = sumSqrs + ( kmsDist - kmsMean ) ^ 2
					end
					local kmsSdev = math.sqrt( sumSqrs / intRecs )
					local kmsSpan = kmsMean + ( kmsSdev * numSdev )	-- Compute mean + standard deviations from centre of sector area

					local isAllOk = true
					for _, intRid in ipairs (tblSect.Rid) do			-- Check each record in this sector area
						local tblRecd = tblRec[intRid]
						if tblRecd.Incl and tblRecd.Dist > kmsSpan and tblRecd.Area == strArea then
							local numSdev = math.floor( ( tblRecd.Dist - kmsMean ) * 10 / kmsSdev ) / 10
							SaveToResultSet(tblRecd,intRid,intSect,numSdev)	-- Report exceptional record found
							tblRecd.Incl = false							-- Exclude this place from later exception reports
							isAllOk = false
						end
					end
					if isAllOk then											-- No exceptions for this cluster of sector area places 
						for _, intRid in ipairs (tblSect.Rid) do
							local tblRecd = tblRec[intRid]
							tblRecd.Type = 0								-- Reset the Type to include place in later area analysis
							tblRecd.Incl = false							-- Exclude this area cluster from later exception reports
						end
					end
				end
			end
		end
		collectgarbage("step",0)											-- Improve run time
	end

	OutputResultSet()

end -- function Main

--[[
@Function:		CheckVersionInStore
@Author:			Mike Tate
@Version:			1.3
@LastUpdated:	03 May 2022
@Description:	Check plugin version against version in Plugin Store
@Parameter:		Plugin name and version
@Returns:			None
@Requires:		lfs & luacom
@V1.3:				Save and retrieve latest version in file;
@V1.2:				Ensure the Plugin Data folder exists;
@V1.1:				Monthly interval between checks; Report if Internet is inaccessible;
@V1.0:				Initial version;
]]

function CheckVersionInStore(strPlugin,strVersion)							-- Check if later Version available in Plugin Store

	require "lfs"
	require "luacom"

	local function OpenFile(strFileName,strMode)								-- Open File and return Handle
		local fileHandle, strError = io.open(strFileName,strMode)
		if fileHandle == nil then
			error("\n Unable to open file in \""..strMode.."\" mode. \n "..strFileName.." \n "..strError.." \n")
		end
		return fileHandle
	end -- local function OpenFile

	local function SaveStringToFile(strString,strFileName)					-- Save string to file
		local fileHandle = OpenFile(strFileName,"w")
		fileHandle:write(strString)
		assert(fileHandle:close())
	end -- local function SaveStringToFile

	local function StrLoadFromFile(strFileName)								-- Load string from file
		local fileHandle = OpenFile(strFileName,"r")
		local strContents = fileHandle:read("*all")
		assert(fileHandle:close())
		return strContents
	end -- local function StrLoadFromFile

	local function httpRequest(strRequest)										-- Luacom http request protected by pcall() below
		local http = luacom.CreateObject("winhttp.winhttprequest.5.1")
		http:Open("GET",strRequest,false)
		http:Send()
		return http.Responsebody
	end -- local function httpRequest

	local function intVersion(strVersion)										-- Convert version string to comparable integer
		local intVersion = 0
		local arrNumbers = {}
		strVersion:gsub("(%d+)", function(strDigits) table.insert(arrNumbers,strDigits) end)
		for i = 1, 5 do
			intVersion = intVersion * 100 + tonumber(arrNumbers[i] or 0)
		end
		return intVersion
	end -- local function intVersion

	local strLatest = "0"
	if strPlugin then
		local strPath = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\"
		local strFile = strPath.."VersionInStore "..strPlugin..".dat"
		local intTime = os.time() - 2600000 									-- Time in seconds a month ago
		local tblAttr, strError = lfs.attributes(strFile)					-- Obtain file attributes
		if not tblAttr or tblAttr.modification < intTime then				-- File does not exist or was modified long ago 
			if lfs.attributes(strPath,"mode") ~= "directory" then
				if not lfs.mkdir(strPath) then return end 					-- Ensure the Plugin Data folder exists
			end
			local strErrFile = strPath.."VersionInStoreInternetError.dat"
			local strRequest ="http://www.family-historian.co.uk/lnk/checkpluginversion.php?name="..tostring(strPlugin)
			local isOK, strReturn = pcall(httpRequest,strRequest)
			if not isOK then														-- Problem with Internet access
				local intTime = os.time() - 36000								-- Time in seconds 10 hours ago
				local tblAttr, strError = lfs.attributes(strErrFile)		-- Obtain file attributes
				if not tblAttr or tblAttr.modification < intTime then		-- File does not exist or was modified long ago 
					fhMessageBox(strReturn.."\n The Internet appears to be inaccessible. ")
				end
				SaveStringToFile(strErrFile,strErrFile)						-- Update file modified time
			else
				os.remove(strErrFile)												-- Delete file if Internet is OK
				if strReturn then
					strLatest = strReturn:match("([%d%.]*),%d*")				-- Version digits & dots then comma and Id digits 
					SaveStringToFile(strLatest,strFile) 						-- Update file modified time and save version
				end
			end
		else
			strLatest = StrLoadFromFile(strFile)								-- Retrieve saved latest version
		end
	end
	if intVersion(strLatest) > intVersion(strVersion or "0") then
		fhMessageBox("Later Version "..strLatest.." of this Plugin is available from the Plugin Store.")
	end
end -- function CheckVersionInStore

if _VERSION ~= "Lua 5.3" then									-- loadrequire for "utf8" and "compat53" libraries

	require 'lfs'
	require 'luacom'
 
	local function httpRequest(url)
		local http = luacom.CreateObject("winhttp.winhttprequest.5.1")
		http:Open("GET",url,false)
		http:Send()
		http:WaitForResponse(30)
		return http
	end -- local function httpRequest
 
	function loadrequire(module,extended)
		if not(extended) then extended = module end
		local function installmodule(module,filename,size)

			local function makesubdirs(path)
				local sep, pStr = package.config:sub(1, 1), ""
				for dir in path:gmatch("[^" .. sep .. "]+") do
					pStr = pStr .. dir .. sep
					lfs.mkdir(pStr)
				end        
			end

			local bmodule = false
			if not(filename) then
				filename = module..'.mod'
				bmodule = true
			end
			local storein = fhGetContextInfo('CI_APP_DATA_FOLDER')..'\\Plugins\\'
			-- Check if subdirectory needed
			local path = string.match(filename, "(.-)[^/]-[^%.]+$")
			if path ~= "" then
				path = path:gsub('/','\\')
				-- Create sub-directory
				makesubdirs(storein..path)
			end
			local attr = lfs.attributes(storein..filename)
			if attr and attr.mode == 'file' and attr.size == size then return true end
			-- Get file down and install it
			local url = "http://www.family-historian.co.uk/lnk/getpluginmodule.php?file="..filename
			local isOK, reply = pcall(httpRequest,url)
			if not isOK then
				fhMessageBox(reply.."\nLoad Require module finds the Internet inaccessible.")
				return false
			end
			local http = reply
			local status = http.StatusText
			if status == 'OK' then
				length = http:GetResponseHeader('Content-Length')
				data = http.ResponseBody
				if bmodule then
					local modlist = loadstring(http.ResponseBody)
					for x,y in pairs(modlist()) do
						if type(x) == 'number' and type(y) == 'string' then
							x = y -- revert to original 'filename' ipairs modlist
							y = 0
						end -- otherwise use ['filename']=size pairs modlist
						if not(installmodule(module,x,y)) then
							break
						end
					end
				else
					local function OpenFile(strFileName,strMode)
						local fileHandle, strError = io.open(strFileName,strMode)
						if not fileHandle then
							error("\n Unable to open file in \""..strMode.."\" mode. \n "..
							strFileName.." \n "..tostring(strError).." \n")
						end
						return fileHandle
					end -- OpenFile
					local function SaveStringToFile(strString,strFileName)
						local fileHandle = OpenFile(strFileName,"wb")
						fileHandle:write(strString)
						assert(fileHandle:close())
					end -- SaveStringToFile
					SaveStringToFile(data,storein..filename)
				end
				return true
			else
				fhMessageBox('An error occurred in Download, so please try later, or perform a manual download from the FHUG Knowledge Base')
				return false
			end
		end
		local function requiref(module)
			require(module)
		end
		local res, err = pcall(requiref,extended)
		if err then
			if  err:match("module '"..extended:gsub("(%W)","%%%1").."' not found") then
				local ans = fhMessageBox(
				'This plugin requires '..module..' support, please click OK to download and install the module, which may take a few minutes in some systems',
				'MB_OKCANCEL','MB_ICONEXCLAMATION')
				if ans ~= 'OK' then
					return false
				end
				if installmodule(module) then
					package.loaded[extended] = nil -- Reset Failed Load
					require(extended)
				else
					return false
				end
			else
				fhMessageBox('Error from require("'..module..'") command:\n'..(err or ''))
				return false
			end
		end
		return true
 	end
end

-- Main Code Section Starts Here --

fhInitialise(6,0,0,"save_recommended")

if fhGetAppVersion() <= 6 then											-- Enable utf8 library
	local path = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugins\\"
	if lfs.attributes(path.."utf8data.lua","mode") ~= "file"
	and lfs.attributes(path.."utf8.lua","mode") == "file" then
	   os.remove(path.."utf8.lua")
	end
	loadrequire("utf8")
	loadrequire("compat53")
end
require("utf8data")
utf8 = require(".utf8")
utf8.config["conversion"] = { uc_lc = utf8_uc_lc; lc_uc = utf8_lc_uc; }
utf8:init()

CheckVersionInStore("Place Exceptions",StrVersion)					-- Notify if later Version

Main()

Source:Place-Exceptions-2.fh_lua