@Jean-Michel
Hello,
Tried something , but need more testing., but the example works.
I am also investigating using a module structure in Maple to make it easier to program the FindPositions ( ) overload command.
restart;
FindPositions := proc()
local
parse_levelspec,
should_process_level,
recursive_search,
extract_first_n,
explain_result,
compare_paths_mathematica,
arg_list, expr, pattern, levelspec, n, heads,
min_level, max_level, result, i, ls_temp,
explanation, test_expected, temp_result, item;
arg_list := [args];
if nops(arg_list) < 2 then
error "FindPositions expects at least 2 arguments: expression and pattern";
end if;
expr := arg_list[1];
pattern := arg_list[2];
levelspec := infinity;
n := infinity;
heads := false;
explanation := false;
test_expected := false;
i := 3;
while i <= nops(arg_list) do
if (type(arg_list[i], {integer, list, set, identical(infinity)})
and levelspec = infinity) then
if type(arg_list[i], set) then
levelspec := [op(arg_list[i])];
else
levelspec := arg_list[i];
end if;
elif type(arg_list[i], posint) and n = infinity then
n := arg_list[i];
elif type(arg_list[i], 'identical'('heads'='true', 'heads'='false')) then
heads := op(2, arg_list[i]);
elif type(arg_list[i], 'equation') and lhs(arg_list[i]) = 'Heads' then
heads := rhs(arg_list[i]);
elif type(arg_list[i], 'identical'('explain'='true', 'explain'='false')) then
explanation := op(2, arg_list[i]);
elif type(arg_list[i], 'equation') and lhs(arg_list[i]) = 'Explain' then
explanation := rhs(arg_list[i]);
elif type(arg_list[i], 'equation') and lhs(arg_list[i]) = 'Test' then
test_expected := rhs(arg_list[i]);
else
error "Invalid argument at position %1: %2", i, arg_list[i];
end if;
i := i + 1;
end do;
# GECORRIGEERDE parse_levelspec die sets accepteert
parse_levelspec := proc(ls)
local ls_list;
if ls = infinity then
return [0, infinity];
elif type(ls, integer) and ls >= 0 then
return [ls, ls];
elif type(ls, list) then
if nops(ls) = 1 and type(ls[1], integer) and ls[1] >= 0 then
return [ls[1], ls[1]];
elif nops(ls) = 2 and type(ls[1], integer) and ls[1] >= 0
and (ls[2] = infinity or (type(ls[2], integer) and ls[2] >= ls[1])) then
return [ls[1], ls[2]];
end if;
elif type(ls, set) then
# Converteer set naar list
ls_list := [op(ls)];
if nops(ls_list) = 1 and type(ls_list[1], integer) and ls_list[1] >= 0 then
return [ls_list[1], ls_list[1]];
elif nops(ls_list) = 2 and type(ls_list[1], integer) and ls_list[1] >= 0
and (ls_list[2] = infinity or (type(ls_list[2], integer) and ls_list[2] >= ls_list[1])) then
return [ls_list[1], ls_list[2]];
end if;
end if;
error "levelspec must be n, {n}, {m,n}, or Infinity, received: %1", ls;
end proc;
should_process_level := proc(current, minlvl, maxlvl)
if current < minlvl then
return false;
elif maxlvl = infinity then
return true;
else
return current <= maxlvl;
end if;
end proc;
compare_paths_mathematica := proc(a, b)
local k, min_len;
min_len := min(nops(a), nops(b));
for k to min_len do
if a[k] < b[k] then
return true;
elif a[k] > b[k] then
return false;
end if;
end do;
return nops(a) < nops(b);
end proc;
# GECORRIGEERDE recursieve zoekfunctie voor {1,2}
recursive_search := proc(expr, pattern, minlvl, maxlvl, path, current_level, heads)
local i, n_items, result, next_level, args_list, term, sub_result, sub;
result := [];
if expr = pattern and should_process_level(current_level, minlvl, maxlvl) then
result := [path];
end if;
if maxlvl <> infinity and current_level >= maxlvl then
return result;
end if;
next_level := current_level + 1;
if type(expr, list) then
n_items := numelems(expr);
for i to n_items do
result := [op(result),
op(procname(expr[i], pattern, minlvl, maxlvl,
[op(path), i], next_level, heads))];
od;
elif type(expr, `+`) then
args_list := [op(expr)];
n_items := numelems(args_list);
# AANPASSING voor {1,2}: bij beperkte niveaus moeten we anders omgaan met sommen
if maxlvl <> infinity then
# Voor {1,2}: alleen exacte matches, niet has()
for i to n_items do
term := args_list[i];
if term = pattern and should_process_level(next_level, minlvl, maxlvl) then
result := [op(result), [op(path), i]];
end if;
od;
else
# Voor infinity: gebruik has() voor patronen binnen termen
for i to n_items do
term := args_list[i];
if has(term, pattern) and should_process_level(next_level, minlvl, maxlvl) then
result := [op(result), [op(path), i]];
end if;
if maxlvl = infinity or next_level < maxlvl then
sub_result := procname(term, pattern, minlvl, maxlvl,
[op(path), i], next_level, heads);
for sub in sub_result do
result := [op(result), op(sub)];
end do;
end if;
od;
end if;
elif type(expr, `*`) then
args_list := [op(expr)];
n_items := numelems(args_list);
for i to n_items do
result := [op(result),
op(procname(args_list[i], pattern, minlvl, maxlvl,
[op(path), i], next_level, heads))];
od;
end if;
return result;
end proc;
extract_first_n := proc(results, n)
local sorted_results;
if n = infinity or n >= nops(results) then
return results;
else
sorted_results := sort(results, compare_paths_mathematica);
return sorted_results[1..min(n, nops(sorted_results))];
end if;
end proc;
(min_level, max_level) := op(parse_levelspec(levelspec));
result := recursive_search(expr, pattern, min_level, max_level, [], 0, heads);
temp_result := [];
for item in result do
if type(item, list) and nops(item) > 0 then
temp_result := [op(temp_result), item];
end if;
end do;
result := temp_result;
result := convert(convert(result, 'set'), 'list');
result := sort(result, compare_paths_mathematica);
result := extract_first_n(result, n);
if explanation then
printf("Expression: %a\n", expr);
printf("Looking for: %a\n", pattern);
printf("Found at %d position(s):\n", nops(result));
for i to nops(result) do
printf("%d. Path %a\n", i, result[i]);
od;
end if;
if test_expected <> false then
if result = test_expected then
printf("✓ TEST PASSED: Result matches expected output\n");
else
printf("✗ TEST FAILED:\n");
printf(" Expected: %a\n", test_expected);
printf(" Got: %a\n", result);
end if;
end if;
return result;
end proc:
# TEST
M := [[1, a], a, [[3 + a]], 2*a - 1]:
# Verify that the other tests still work
printf("\n=============================================\n");
printf("VERIFICATION OF OTHER TESTS:\n");
printf("=============================================\n");
printf("TEST 1: All positions of 'a' in M\n");
result1 := FindPositions(M, a, 'Test' = [[1, 2], [2], [3, 1, 1, 2], [4, 1]]);
printf("Result: %a\n\n", result1);
printf("TEST 2: Level 1 only\n");
result2 := FindPositions(M, a, 1, 'Test' = [[2]]);
printf("Result: %a\n\n", result2);
printf("=============================================\n");
printf("TEST 3 ONLY: Levels 1 and 2\n");
printf("Expected: [[1, 2], [2]]\n");
printf("=============================================\n");
result3 := FindPositions(M, a, {1, 2}, 'Test' = [[1, 2], [2]]);
printf("Result: %a\n", result3);
printf("TEST 4: From level 2 onwards\n");
result4 := FindPositions(M, a, {2, infinity}, 'Test' = [[1, 2], [3, 1, 1, 2], [4, 1]]);
printf("Result: %a\n\n", result4);
printf("TEST 5: First 2 results\n");
result5 := FindPositions(M, a, infinity, 2, 'Test' = [[1, 2], [2]]);
printf("Result: %a\n", result5);
