--[[ @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()