//\r
// Send message methods:\r
// delete_data - Clear the matrix\r
-// matrix_sort - Y pos to sort on\r
+// [obsolete] matrix_sort - Y pos to sort on, ASC OR DESC\r
+// sort_items - Y pos to sort on, ASC OR DESC (auto detects)\r
+// sort_items_ascii - Y pos to sort on, ASC OR DESC (ascii)\r
+// sort_items_num - Y pos to sort on, ASC OR DESC (numeric)\r
// matrix_delete - X and Y pos to delete \r
// delete_item - X position to delete (this reshuffles the matrix; avoid using)\r
// hash_on_column_algorithm - Hash algorithm to use\r
// hash_is_unique - Add a unique constraint on the hash\r
// remove_hash_is_unique - Remove a unique constraint from the hash\r
// matrix_index_lookup_clear - Clear the lookup buffer\r
-// matrix_append_csv - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')\r
-// matrix_copy_csv - Copy csv data from sprecified file into matrix\r
+// matrix_append_csv - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')\r
+// matrix_copy_csv_in - Copy csv data from specified file into matrix\r
+// matrix_copy_csv_in_header - Copy csv data with header from specified file into matrix\r
+// matrix_copy_csv_out - Copy csv data from matrix into specified file\r
//\r
// Set methods:\r
// matrix_value - Set a value at X, Y\r
// matrix_index_lookup_clear - Clear the buffer for an indexed lookup\r
// matrix_index_count_from_value - Get a count of rows with a particular value\r
// matrix_index_from_value - Get the next X pos (row) with indexed value. Returns -1 when nothing left to find.\r
-// item_count - Get count of rows in matrix\r
-// item_width - Get count of columns in matrix\r
+// item_count - Get count of rows in matrix\r
+// item_width - Get count of columns in matrix\r
// \r
// Example usage:\r
//\r
// set matrix_value of (test(current_object)) item 0 item 1 to "1" - x then y pos to Value\r
// get matrix_value of (test(current_object)) item 0 item 1 to tmpStr - x then y pos to Value\r
// send matrix_append_csv to test ('My Name,"My,\"address\""') - Append CSV data to the end of the matrix\r
-// send matrix_copy_csv to (test(current_object)) "f:\data.csv" - Copy data from csv file into matrix\r
-// send matrix_sort to (test(current_object)) 1 - x then y pos to sort by\r
+// send matrix_copy_csv_in to (test(current_object)) "f:\data.csv" - Copy data from csv file into matrix\r
+// [obsolete] send matrix_sort to (test(current_object)) 1 ASC - y pos to sort by, ASCENDING/DESCENDING\r
+// send sort_items to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (auto)\r
+// send sort_items_ascii to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (ascii)\r
+// send sort_items_num to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (numeric)\r
// send matrix_delete to (test(current_object)) 1 1 - x then y pos to delete \r
// send matrix_delete_row to (test(current_object)) 1 - x essentially blanks record out, no reshuffle\r
// send delete_item to (test(current_object)) 1 - x pos (not v efficient), reshuffles\r
// get matrix_index_from_value of (test(current_object)) item "1" to x_pos \r
// get matrix_indextable_from_value of (test(current_object)) item "1" to tmpStr \r
// get matrix_hash_from_value of (test(current_object)) item "1" to tmpInt \r
-// get item_count of (test(current_object) to tmpInt\r
+// get item_count of (test(current_object) to tmpInt\r
// get item_width of (test(current_object) to tmpInt\r
\r
class matrix is an array\r
set c_iLastIndexTableHash to -1\r
set c_iLastIndexTablePos to -1\r
set c_iEnforceUnique to 0\r
- end_procedure\r
+ end_procedure \r
+ \r
+ // Pull the value of a column from the string representation\r
+ function column_value integer itemy string row\r
+ local string l_sResult\r
+ local integer l_i\r
+ \r
+ move row to l_sResult\r
+ \r
+ for l_i from 0 to (itemy-1)\r
+ move (right(l_sResult,length(l_sResult)-pos(character(1),l_sResult))) to l_sResult\r
+ loop\r
+ move (left(l_sResult,pos(character(1),l_sResult)-1)) to l_sResult\r
+ \r
+ function_return l_sResult\r
+ end_function \r
\r
procedure hash_on_column_algorithm string hashalg\r
if ((hashalg = "hash_reduced_djb2") or (hashalg = "hash_reduced_sdbm") or (hashalg = "hash_reduced_lazy") or (hashalg = "hash_for_df_arrays") or (hashalg = "")) begin\r
\r
for l_i from 0 to l_iMax\r
forward get array_value item l_i to l_sBuf\r
- \r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item l_iColumn to l_sTmp \r
+\r
+ get column_value item l_iColumn item l_sBuf to l_sTmp\r
+ \r
get insert_hash of (mHash_table(current_object)) item l_sTmp to l_iHash\r
get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
\r
\r
if (l_iHashOn <> -1) begin \r
set c_iHashOn to -1\r
+ set c_iLastIndexTableHash to -1\r
+ set c_iLastIndexTablePos to -1\r
send destroy_object to (mHash_array(current_object))\r
send destroy_object to (mHash_table(current_object))\r
end\r
end_procedure\r
\r
procedure matrix_append_csv string row \r
- local integer l_iMax l_iValues l_i\r
+ local integer l_iMax l_iValues l_i l_iHashOn l_iWidth l_iCount\r
local string l_sBuf\r
\r
+ get c_iHashOn to l_iHashOn\r
forward get item_count to l_iMax\r
- \r
- send delete_data to (mTokens2(current_object))\r
- send set_string_csv to (mTokens2(current_object)) row\r
- get token_count of (mTokens2(current_object)) to l_iValues\r
- \r
- for l_i from 0 to l_iValues \r
- get token_value of (mTokens2(current_object)) item l_i to l_sBuf\r
- indicate err false\r
- set matrix_value item l_iMax item l_i to l_sBuf \r
- if (err) forward send delete_item l_iMax\r
- if (err) break\r
- loop\r
+ \r
+ if ((l_iHashOn <> -1) or (row contains '"')) begin \r
+ send delete_data to (mTokens2(current_object))\r
+ send set_string_csv to (mTokens2(current_object)) row\r
+ get token_count of (mTokens2(current_object)) to l_iValues\r
+ \r
+ for l_i from 0 to l_iValues \r
+ get token_value of (mTokens2(current_object)) item l_i to l_sBuf\r
+ indicate err false\r
+ set matrix_value item l_iMax item l_i to l_sBuf \r
+ if (err) forward send delete_item l_iMax\r
+ if (err) break\r
+ loop\r
+ end\r
+ else begin\r
+ get c_iWidth to l_iWidth \r
+ move 0 to l_iCount\r
+ forward set array_value item l_iMax to (replaces(',', row, character(1)))\r
+ for l_i from (pos(',', row)) to (length(row))\r
+ if (mid(row,1,l_i) = ',') increment l_iCount\r
+ loop \r
+ if (l_iCount > l_iWidth) set c_iWidth to l_iCount\r
+ end\r
\r
end_procedure\r
+\r
+ procedure matrix_copy_csv_worker string fname integer offset\r
+ local string l_sBuf \r
+ local integer l_i\r
+ \r
+ move 0 to l_i\r
+ if (does_exist(fname)) begin\r
+ direct_input channel DEFAULT_FILE_CHANNEL fname\r
+ while not (seqeof)\r
+ readln channel DEFAULT_FILE_CHANNEL l_sBuf\r
+ increment l_i\r
+ if (l_i <= offset) break begin\r
+ if (seqeof) break\r
+ if (trim(l_sBuf) <> "") begin\r
+ send matrix_append_csv l_sBuf\r
+ end\r
+ loop\r
+ close_input channel DEFAULT_FILE_CHANNEL\r
+ end\r
+ else;\r
+ custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname\r
+ \r
+ end_procedure \r
\r
- procedure matrix_copy_csv string fname\r
- local string l_sBuf\r
- \r
- if (does_exist(fname)) begin\r
- direct_input channel DEFAULT_FILE_CHANNEL fname\r
- while not (seqeof)\r
- readln channel DEFAULT_FILE_CHANNEL l_sBuf\r
- if (seqeof) break\r
- if (trim(l_sBuf) <> "") begin\r
- send matrix_append_csv l_sBuf\r
- end\r
- loop\r
- close_input channel DEFAULT_FILE_CHANNEL\r
- end\r
- else;\r
- custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname \r
- end_procedure \r
- \r
- function matrix_string integer itemx integer itemy returns string\r
- local string l_sBuf l_sTmp\r
+ procedure matrix_copy_csv_in string fname\r
+ send matrix_copy_csv_worker fname 0\r
+ end_procedure \r
\r
- forward get array_value item itemx to l_sBuf\r
+ procedure matrix_copy_csv_in_header string fname\r
+ send matrix_copy_csv_worker fname 1\r
+ end_procedure \r
\r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+ procedure matrix_copy_csv_out string fname \r
+ local integer l_iMax l_i l_j l_iValues\r
+ local string l_sBuf\r
\r
- function_return l_sTmp\r
- end_function \r
+ forward get item_count to l_iMax\r
+ \r
+ direct_output channel DEFAULT_FILE_CHANNEL fname\r
+ for l_i from 0 to l_iMax\r
+ forward get string_value item l_i to l_sBuf\r
+ if (l_sBuf <> "") begin\r
+ if ((l_sBuf contains '"') or (l_sBuf contains ',')) begin\r
+ send delete_data to (mTokens2(current_object))\r
+ send set_string to (mTokens2(current_object)) l_sBuf (character(1))\r
+ get token_count of (mTokens2(current_object)) to l_iValues\r
+ \r
+ for l_j from 0 to l_iValues \r
+ get token_value of (mTokens2(current_object)) item l_j to l_sBuf\r
+ if (l_j <> 0);\r
+ write channel DEFAULT_FILE_CHANNEL ','\r
+ if (l_sBuf contains '"');\r
+ write channel DEFAULT_FILE_CHANNEL ('"'+(replaces('"', l_sBuf, '\"'))+'"')\r
+ else;\r
+ write channel DEFAULT_FILE_CHANNEL l_sBuf\r
+ loop\r
+ writeln channel DEFAULT_FILE_CHANNEL ""\r
+ end\r
+ else;\r
+ writeln channel DEFAULT_FILE_CHANNEL (replaces(character(1), l_sBuf, ','))\r
+ end\r
+ loop\r
+ close_output channel DEFAULT_FILE_CHANNEL\r
+ end_procedure \r
+ \r
\r
function matrix_value integer itemx integer itemy returns string\r
local string l_sBuf l_sTmp\r
\r
forward get array_value item itemx to l_sBuf\r
+ get column_value item itemy item l_sBuf to l_sTmp\r
\r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+ function_return l_sTmp\r
+ end_function \r
+ \r
+ function matrix_string integer itemx integer itemy returns string\r
+ local string l_sTmp\r
+\r
+ get matrix_value item itemx item itemy to l_sTmp\r
\r
function_return l_sTmp\r
end_function \r
\r
function matrix_integer integer itemx integer itemy returns integer\r
- local string l_sBuf\r
local integer l_iTmp\r
-\r
- forward get array_value item itemx to l_sBuf\r
\r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item itemy to l_iTmp\r
+ get matrix_value item itemx item itemy to l_iTmp\r
\r
function_return l_iTmp\r
end_function\r
\r
function matrix_number integer itemx integer itemy returns number\r
- local string l_sBuf\r
local number l_nTmp\r
\r
- forward get array_value item itemx to l_sBuf\r
- \r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item itemy to l_nTmp\r
+ get matrix_value item itemx item itemy to l_nTmp\r
\r
function_return l_nTmp\r
end_function\r
\r
function matrix_real integer itemx integer itemy returns real\r
- local string l_sBuf\r
local real l_rTmp\r
\r
- forward get array_value item itemx to l_sBuf\r
- \r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
- get token_value of (mTokens(current_object)) item itemy to l_rTmp\r
+ get matrix_value item itemx item itemy to l_rTmp\r
\r
function_return l_rTmp\r
end_function\r
\r
get c_iHashOn to l_iHashOn\r
move -1 to l_iIndex\r
+ move 0 to l_iLastIndexTablePos\r
\r
if (l_iHashOn <> -1) begin\r
get find_hash of (mHash_table(current_object)) item val to l_iHash\r
end_function\r
\r
function matrix_index_count_from_value string val returns integer\r
- local integer l_iHashOn l_iHash l_iIndexValues\r
+ local integer l_iHashOn l_iHash l_iIndexValues l_i\r
local string l_sIndexTable\r
\r
get c_iHashOn to l_iHashOn\r
get find_hash of (mHash_table(current_object)) item val to l_iHash\r
get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
\r
- send delete_data to (mTokens(current_object))\r
- send set_string to (mTokens(current_object)) l_sIndexTable "|"\r
- get token_count of (mTokens(current_object)) to l_iIndexValues\r
+ move 0 to l_iIndexValues\r
+ for l_i from 1 to (length(l_sIndexTable))\r
+ if (mid(l_sIndexTable,1,l_i) = '|');\r
+ increment l_iIndexValues\r
+ loop\r
end\r
\r
- function_return l_iIndexValues\r
+ function_return (l_iIndexValues-1)\r
end_function\r
\r
procedure set item_count integer newVal\r
end_procedure\r
\r
function item_width returns integer\r
- local integer l_iWidth\r
- get c_iWidth to l_iWidth\r
- function_return l_iWidth\r
+ local integer l_iWidth\r
+ get c_iWidth to l_iWidth\r
+ function_return l_iWidth\r
end_function\r
\r
procedure matrix_delete integer itemx integer itemy\r
forward send delete_item to current_object itemx\r
end_procedure\r
\r
- procedure matrix_sort integer itemy string order \r
+ // The routine below relies on the internal dataflex sort, doing\r
+ // what is essentially a nested loop join on the result and rebuilding\r
+ // the original matrix. It's pretty awful and is only left here for\r
+ // reference. Behaviour isn't quite quadratic, a feeble guess is\r
+ // something like O( (2N + Nlog(n) + N^1.8) :-(\r
+ procedure matrix_sort integer itemy string order\r
local string l_sBuf l_sTmp l_sTmp2 l_sHash\r
local integer l_iX l_i l_j l_iMax l_iPoolMax l_iWidth l_iThrow l_iNumCount l_iHashOn l_iHash\r
\r
move (trim(uppercase(order))) to order\r
- if ((order <> "ASCENDING") and (order <> "DESCENDING")) move "ASCENDING" to order\r
+ if ((left(order,3) <> "ASC") and (left(order,4) <> "DESC")) move "ASCENDING" to order\r
\r
object mSort_array is an array\r
end_object\r
send delete_data to (mClone_array(current_object))\r
\r
if (l_iHashOn <> -1) begin\r
+ //Zero the hash\r
send delete_data to (mHash_array(current_object))\r
end\r
\r
\r
move 0 to l_iNumCount \r
for l_j from 1 to (length(l_sTmp))\r
- if (((ascii(mid(l_sTmp,1,l_j))) >= 48) and ((ascii(mid(l_sTmp,1,l_j))) <= 57) or ((ascii(mid(l_sTmp,1,l_j))) = 46)) begin\r
- increment l_iNumCount\r
- end\r
+ if not (((ascii(mid(l_sTmp,1,l_j))) >= 48) and ((ascii(mid(l_sTmp,1,l_j))) <= 57) or ((ascii(mid(l_sTmp,1,l_j))) = 46)) break\r
+ increment l_iNumCount\r
loop\r
if ((length(l_sTmp) > 0) and (length(l_sTmp) = l_iNumCount)) begin\r
set array_value of (mSort_array(current_object)) item l_i to (number(l_sTmp))\r
end\r
loop\r
\r
- if (order = "ASCENDING") send sort_items to (mSort_array(current_object)) ascending\r
- if (order = "DESCENDING") send sort_items to (mSort_array(current_object)) descending\r
+ //Rely on dataflex sort\r
+ if (left(order,3) = "ASC") send sort_items to (mSort_array(current_object)) ascending\r
+ if (left(order,4) = "DESC") send sort_items to (mSort_array(current_object)) descending\r
\r
move l_iMax to l_iPoolMax\r
\r
+ // Nested loop join, sort of. Not good :-(\r
for l_i from 0 to l_iMax\r
get array_value of (mSort_array(current_object)) item l_i to l_sTmp\r
if (l_sTmp = character(2)) move "" to l_sTmp\r
forward send delete_item to current_object l_iPoolMax\r
decrement l_iPoolMax \r
\r
- // Remap hash\r
+ // Rebuild hash\r
if (l_iHashOn <> -1) begin \r
get token_value of (mTokens(current_object)) item l_iHashOn to l_sHash\r
get find_hash of (mHash_table(current_object)) item l_sHash to l_iHash\r
send destroy_object to (mSort_array(current_object)) // Use "send request_destroy_object" to destroy object and all children.\r
send destroy_object to (mClone_array(current_object))\r
end_procedure\r
+\r
+ \r
+ // Recursive partition for quicksort.\r
+ // Dataflex arrays track the type of each row and perform a sort acordingly\r
+ // but we have no easy way of knowing. So perform compare based on what a\r
+ // value looks "like" unless told otherwise. \r
+ // Index from (lo_in), index to (hi_in), numeric/string mode (1=integer, 0=string), invert (1=descending, 0=ascending)\r
+ procedure partition integer lo_in integer hi_in integer mode integer itemy integer invert\r
+ local integer pivot lo_idx hi_idx t\r
+ local string pivot_val lo_row hi_row lo_val hi_val \r
+ \r
+ if ((hi_in-lo_in) > 0) begin\r
+ move lo_in to lo_idx\r
+ move hi_in to hi_idx \r
+ move ((lo_in+hi_in)/2) to pivot\r
+ \r
+ while ((lo_idx <= pivot) AND (hi_idx >= pivot))\r
+ \r
+ forward get array_value item pivot to pivot_val\r
+ get column_value item itemy item pivot_val to pivot_val\r
+ \r
+ forward get array_value item lo_idx to lo_row\r
+ get column_value item itemy item lo_row to lo_val\r
+\r
+ forward get array_value item hi_idx to hi_row\r
+ get column_value item itemy item hi_row to hi_val\r
+\r
+ \r
+ if (invert) begin\r
+ while ( ( ((mode) and (number(lo_val) > number(pivot_val))) or (not (mode) and (lo_val > pivot_val))) and (lo_idx <= pivot))\r
+ increment lo_idx\r
+ forward get array_value item lo_idx to lo_row\r
+ get column_value item itemy item lo_row to lo_val\r
+ loop\r
+ while ( ( ((mode) and (number(hi_val) < number(pivot_val))) or (not (mode) and (hi_val < pivot_val))) and (hi_idx >= pivot))\r
+ decrement hi_idx\r
+ forward get array_value item hi_idx to hi_row\r
+ get column_value item itemy item hi_row to hi_val\r
+ loop\r
+ end\r
+ else begin\r
+ while ( ( ((mode) and (number(lo_val) < number(pivot_val))) or (not (mode) and (lo_val < pivot_val))) and (lo_idx <= pivot))\r
+ increment lo_idx\r
+ forward get array_value item lo_idx to lo_row\r
+ get column_value item itemy item lo_row to lo_val\r
+ loop\r
+ while ( ( ((mode) and (number(hi_val) > number(pivot_val))) or (not (mode) and (hi_val > pivot_val))) and (hi_idx >= pivot))\r
+ decrement hi_idx\r
+ forward get array_value item hi_idx to hi_row\r
+ get column_value item itemy item hi_row to hi_val\r
+ loop\r
+ end\r
+ \r
+ forward set array_value item lo_idx to hi_row\r
+ forward set array_value item hi_idx to lo_row\r
+ \r
+ increment lo_idx\r
+ decrement hi_idx\r
+ \r
+ if ((lo_idx-1) = pivot) begin\r
+ increment hi_idx\r
+ move hi_idx to pivot\r
+ end\r
+ else if ((hi_idx+1) = pivot) begin\r
+ decrement lo_idx\r
+ move lo_idx to pivot\r
+ end\r
+ \r
+ loop\r
+ \r
+ if ((pivot-lo_in) > 1);\r
+ send partition lo_in (pivot-1) mode itemy invert\r
+ if ((hi_in-pivot) > 1);\r
+ send partition (pivot+1) hi_in mode itemy invert\r
+ end \r
+ end_procedure \r
+ \r
+ // Perform a quick sort on a perticular column (y) in the martix\r
+ // This is done in native dataflex, so no match for compiled C\r
+ procedure quick_sort integer itemy string order integer mode\r
+ local integer l_i l_j l_iHashOn l_iMax l_iInvert\r
+ local string l_sBuf\r
+ \r
+ if (uppercase(left(trim(order),4)) = "DESC") move 1 to l_iInvert\r
+ else move 0 to l_iInvert \r
+ \r
+ get item_count to l_iMax\r
+ \r
+ // If we've not been told string/numeric, try and work out here.\r
+ if (mode = -1) begin\r
+ for l_i from 0 to (l_iMax-1)\r
+ forward get array_value item l_i to l_sBuf\r
+ get column_value item itemy item l_sBuf to l_sBuf\r
+ move (is_number(l_sBuf)) to mode\r
+ if (mode = 0) break\r
+ loop\r
+ end\r
+ \r
+ // Remove the current hash index if there is one \r
+ get c_iHashOn to l_iHashOn\r
+ if (l_iHashOn <> -1);\r
+ send remove_hash_on_column \r
+ \r
+ // Do the quick-sort\r
+ send partition 0 (l_iMax-1) mode itemy l_iInvert\r
+ \r
+ // Recreate any the hash if there was one\r
+ if (l_iHashOn <> -1);\r
+ send hash_on_column l_iHashOn\r
+\r
+ end_procedure\r
+ \r
+ //Wrapper for sort_items\r
+ procedure sort_items integer itemy string order\r
+ send quick_sort itemy order -1\r
+ end_procedure\r
+ \r
+ //Wrapper for sort_items\r
+ procedure sort_items_ascii integer itemy string order\r
+ send quick_sort itemy order 0\r
+ end_procedure \r
+ \r
+ //Wrapper for sort_items\r
+ procedure sort_items_num integer itemy string order\r
+ send quick_sort itemy order 1\r
+ end_procedure \r
\r
end_class\r
\r
projects / dataflex / df32func / blobdiff