-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpositions
126 lines (98 loc) · 6.72 KB
/
positions
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
/*------------------------------------------------------------------------------------------------------*/
load(basic);
/*------------------------------------------------------------------------------------------------------*/
load("C:\\Users\\joker\\Documents\\Maxima-Docs\\segment-new.lisp");
/* Get segment from http://www.cs.berkeley.edu/~fateman/lisp/segment-new.lisp */
/*------------------------------------------------------------------------------------------------------*/
use_segment(true);
/*------------------------------------------------------------------------------------------------------*/
/* Same as Mathematica's MapIndex API,
mapindexed([a,b,c,d,[e,[f,g]]]);=> [[a,1],[b,2],[c,3],[d,4],[[e,[f,g]],5]] */
mapindexed(lis):=block([fin:[],count:0],for item in lis do
(count:count+1,push([item,count],fin))
,reverse(fin))$
/*------------------------------------------------------------------------------------------------------*/
assign_positions(lis):=block([ltemp2:[],count:0],
for item in lis do if(listp(item)) then
(
push([assign_positions(item),[count:count+1]],ltemp2))
else (push([item,[count:count+1]],ltemp2))
,reverse(ltemp2))$
/*------------------------------------------------------------------------------------------------------*/
call_from_inside(lis):=block([olast:[],temp:0,final:[],prev,final_f:[]],olast:from_inside(lis),
for item in reverse(final) do (
if(atom(first(item))) then push(item,final_f) else
push([part(tlist,apply(segment,(last(item)))),last(item)],final_f)),reverse(final_f))$
/*------------------------------------------------------------------------------------------------------*/
/* Assign positions to all the elements including sublists in a list
enum_positions([a,b,c,d,[e,[f,g]]]); =>
[[a,[1]],[b,[2]],[c,[3]],[d,[4]],[[e,[f,g]],[5]],[e,[5,1]],[[f,g],[5,2]],[f,[5,2,1]],[g,[5,2,2]]] */
enum_positions(listt):=block([tlist:listt],call_from_inside(assign_positions(listt)))$
/*------------------------------------------------------------------------------------------------------*/
from_inside(lis):=block([count:0,temps],for item in lis do
(if(atom(first(item))) then (
if(olast=[]) then (push(item,final))
else (push([first(item),flatten(endcons(last(item),reverse(olast)))],final)))
else ( push([item,flatten(endcons(last(item),reverse(olast)))],final),
push(last(item),olast),from_inside(first(item)),
pop(olast))))$
/*------------------------------------------------------------------------------------------------------*/
call_expr_tree(lis):=block([final:[],curr_exp],expr_tree(lis),
if(final#[]) then (final:map(lambda([x],[cons(first(first(x)),last(first(x))),last(x)]),final),
finalize_list(final))
else lis)$
/*------------------------------------------------------------------------------------------------------*/
expr_tree(lis):=block([oper],if(atom(lis)=false) then (oper:op(lis),push([[oper,args(lis)],curr_exp],final),
(for i:1 thru length(args(lis)) do (curr_exp:args(lis)[i],expr_tree(args(lis)[i]))))else lis)$
/*Usage
call_expr_tree(a*s^10+cos(w)*tan(q)+10);
["+",["*",[tan,q],[cos,w]],["*",a,["^",s,10]],10] */
/*======================================================================================================*/
/*To get the work done by two APIs above, as suggested by Batron Willis,*/
call_expr_tree(e) := if mapatom(e) then e else(cons(op(e), map('call_expr_tree,args(e))))$
/*usage
call_expr_tree(a*s^10+cos(w)*tan(q)+10);
["+",["*",[tan,q],[cos,w]],["*",a,["^",s,10]],10] */
/*=====================================================================================================*/
finalize_list(tt):=block(for item:1 thru length(tt) do (
for i:1 thru length(tt) do (
for j:1 thru length(first(tt[i])) do (
if(last(tt[item])=first(tt[i])[j]) then
first(tt[i])[j]:tt[item][1]))),first(last(tt)))$
/*------------------------------------------------------------------------------------------------------*/
positionsof(elem,lis):=sublist(enum_positions(lis),lambda([x],first(x)=elem))$
/*usage
positionsof(f,[a,b,c,d,[e,[f,g]]]); => [[f,[5,2,1]]] */
/*------------------------------------------------------------------------------------------------------*/
assign_positions_expr(lis):=block([ltemp2:[],count:-1],
for item in lis do if(listp(item)) then
(push([assign_positions_expr(item),[count:count+1]],ltemp2))
else (push([item,[count:count+1]],ltemp2))
,reverse(ltemp2))$
/*------------------------------------------------------------------------------------------------------*/
call_from_inside(lis):=block([olast:[],temp:0,final:[],prev,final_f:[]],olast:from_inside(lis),
for item in reverse(final) do (
if(atom(first(item))) then push(item,final_f) else
push([part(tlist,apply(segment,(last(item)))),last(item)],final_f)),reverse(final_f))$
/*------------------------------------------------------------------------------------------------------*/
call_from_inside_expr(lis):=block([final_f:[],olast:[],temp:0,final:[]],olast:from_inside(lis),
for item in reverse(final) do (
if(atom(first(item))) then push(item,final_f) else
push([part(tlist,apply(segment,(last(item)))),last(item)],final_f)),reverse(final_f))$
/*------------------------------------------------------------------------------------------------------*/
from_inside_expr(lis):=block([count:0],for item in lis do
(if(atom(first(item))) then (
if(olast=[]) then (push(item,final))
else (push([first(item),flatten(endcons(last(item),reverse(olast)))],final)))
else (push([first(item),flatten(endcons(last(item),reverse(olast)))],final),
push(last(item),olast),from_inside_expr(first(item)),
pop(olast))))$
/*------------------------------------------------------------------------------------------------------*/
positions_expr(expr):=block([tlist:expr,temp],temp:call_expr_tree(expr),
temp:call_from_inside_expr(assign_positions_expr(temp)),
temp)$
/*usage
positions_expr(a*s^10+cos(w)*tan(q)+10);
[["+",[0]],[tan(q)*cos(w),[1]],["*",[1,0]],[tan(q),[1,1]],[tan,[1,1,0]],[q,[1,1,1]],[cos(w),[1,2]],[cos,[1,2,0]],[w,[1,2,1]],[a*s^10,[2]],["*",[2,0
]],[a,[2,1]],[s^10,[2,2]],["^",[2,2,0]],[s,[2,2,1]],[10,[2,2,2]],[10,[3]]] */
/*------------------------------------------------------------------------------------------------------*/