chakravala / Reduce.jl
1
#   This file is part of Reduce.jl. It is licensed under the MIT license
2
#   Copyright (C) 2017 Michael Reed
3

4
export RExpr, @RExpr, @R_str, rcall, @rcall, convert, ==, string, show, squash, list
5
import Base: parse, convert, ==, getindex, *, split, string, show, join, String
6

7
export ExprSymbol
8
const ExprSymbol = Union{<:Expr,<:Symbol}
9

10
"""
11
Reduce expression
12

13
### Summary:
14
type RExpr <: Any
15

16
### Fields:
17
str::Array{Compat.String,1}
18
"""
19
struct RExpr
20
    str::Array{String,1}
21 28
    RExpr(r::Array{String,1}) = new(r)
22
end
23

24 28
RExpr(r::Array{SubString{String},1}) = RExpr(convert(Array{String,1},r))
25 28
RExpr(str::String) = RExpr([str])
26 0
RExpr(t::Bool) = RExpr(t ? 1 : 0)
27

28
"""
29
    RExpr(e::Expr)
30

31
Convert Julia expression to Reduce expression
32

33
## Examples
34
```julia-repl
35
julia> RExpr(:(sin(x*im) + cos(y*ϕ)))
36

37
     sqrt(5)*y + y
38
cos(---------------) + sinh(x)*i
39
           2
40
```
41
"""
42 28
RExpr(expr::Expr) = expr |> unparse |> RExpr |> split
43

44 4
function RExpr(r::T) where T <: Union{Array,Adjoint,Tuple,Pair}
45 28
    out = IOBuffer()
46 28
    show_expr(out,r)
47 28
    return out |> take! |> String |> RExpr
48
end
49

50 4
function RExpr(r::Any)
51 28
    if typeof(r) <: AbstractFloat && isinf(r)
52 28
        return RExpr((r > 0 ? "" : "-")*"infinity")
53 16
    elseif typeof(r) <: Irrational
54 0
        return RExpr(unparse_irrational(r))
55 16
    elseif typeof(r) <: Complex{Bool}
56 0
        return RExpr("i")
57 16
    elseif typeof(r) <: Complex
58 24
        return RExpr("$(r.re)+$(r.im)*i")
59
    end
60 28
    y = "$r"
61 28
    for key  keys(repjlr)
62 28
        y = replace(y, key => repjlr[key])
63
    end
64 28
    return RExpr(y)
65
end
66

67
macro RExpr(r)
68
    RExpr(r)
69
end
70

71 4
macro R_str(str)
72 28
    RExpr(str)
73
end
74

75
function rtrim(r::Array{String,1})
76 28
    n = deepcopy(r)
77 0
    h = 1
78 24
    l = length(r)
79 28
    while h  l
80 28
        isempty(n[h]) ? (deleteat!(n,h); l -= 1) : (h += 1)
81
    end
82 28
    return n
83
end
84

85 4
function split(r::RExpr)
86 28
    n = String[]
87 28
    for h  1:length(r.str)
88 28
        p = split(replace(r.str[h],r"(\$)|(;\n)"=>";"),r"(?<!\!#[0-9a-fA-F]{4});")
89 28
        for t  1:length(p)
90 28
            push!(n,p[t])
91
    end; end
92 28
    return RExpr(rtrim(n))
93
end
94

95 24
String(r::RExpr) = convert(String,r)
96 28
string(r::RExpr) = convert(String,r)
97 28
join(r::RExpr) = RExpr(string(r))
98 28
join(r::Array{RExpr,1}) = vcat(convert.(Array{String,1},r)...) |> RExpr
99 28
show(io::IO, r::RExpr) = print(io,convert(String,r))
100

101
cols = 80
102

103
"""
104
    linelength()
105

106
This operator is used with the syntax
107
```Julia
108
Reduce.linelength()::Integer
109
```
110
and sets the output line length to the integer `tput cols`. It returns the output line length (so that it can be stored for later resetting of the output line if needed).
111
"""
112 4
function linelength()
113 28
    c = displaysize(stdout)[2]
114 8
    global cols
115 28
    if c  cols
116 0
        ws = rcall("ws")
117 0
        rcall("linelength($c)")
118 0
        rcall(ws)
119 0
        cols = c
120
    end
121 28
    return c
122
end
123

124 4
function show(io::IO, ::MIME"text/plain", r::RExpr)
125 28
    length(r.str) > 1 && (print(io,string(r),";"); return nothing)
126 28
    ColCheck() && linelength()
127 28
    print(io,rcall(r;on=[:nat]) |> string |> chomp)
128
end
129

130 4
function show(io::IO, ::MIME"text/latex", r::RExpr)
131 28
    rcall(R"on latex")
132 28
    write(rs,r)
133 28
    rd = readsp(rs)
134 28
    rcall(R"off latex")
135 24
    sp = split(join(rd),"\n\n")
136 24
    print(io,"\\begin{eqnarray}\n")
137 8
    ct = 0 # add enumeration
138 28
    for str  sp
139 24
        ct += 1 
140 28
        length(sp)  1 && print(io,"($ct)"*'&'*"\\,")
141 24
        print(io,replace(str,r"(\\begin{displaymath})|(\\end{displaymath})"=>""))
142 28
        ct  length(sp) && print(io,"\\\\\\\\")
143
    end # new line
144 28
    print(io,"\n\\end{eqnarray}")
145
end
146

147
function extract end
148

149
"""
150
    Reduce.@subtype
151

152
Can be used to create an `RExpr` wrapper type with a subtype relation
153
```Julia
154
julia> Reduce.@subtype FakeReal <: Real
155

156
julia> FakeReal(:(x+1)) + FakeReal(:y)
157
y + 1 + x
158
```
159
"""
160 4
macro subtype(x)
161 28
    x.head  :<: && throw(error("$x is not a subtype expression"))
162 28
    name = x.args[1]
163 28
    Expr(:struct,false,x,Expr(:block,Expr(:(::), :r, :RExpr))) |> eval
164 28
    Expr(:block,[:($fun(r::$name) = $fun(r.r)) for fun  [:String,:string,:join,:list,:parse,:mat]]...) |> eval
165 28
    @eval begin
166
        export $name
167 28
        $name(x) = $name(RExpr(x))
168 24
        RExpr(r::$name) = r.r
169 0
        show(io::IO, r::$name) = show(io,r.r)
170 28
        ==(a::$name,b::$name) = a.r == b.r
171 0
        rcall(r::$name,s...) = rcall(r.r,s...)
172 0
        convert(::Type{$name}, r::RExpr) = r.r
173 0
        convert(::Type{Array{String,1}}, r::$name) = r.r.str
174 0
        convert(::Type{String}, r::$name) = convert(String,r.r)
175
        Algebra.init_subtype($name)
176
    end
177 28
    nothing
178
end
179

180
const r_to_jl = Dict(
181
    "i"             =>  "im",
182
    "infinity"      =>  "Inf"
183
)
184

185
const r_to_jl_utf = Dict(
186
    "pi"            =>  "π",
187
    "e"             =>  "ℯ",
188
    "euler_gamma"   =>  "MathConstants.γ",
189
    "golden_ratio"  =>  "MathConstants.φ"
190
)
191

192
const r_to_jl_ifx = Dict(
193
    "**"            =>  "^",
194
    "/"             =>  "/"
195
    #"~"             =>  "\""
196
)
197

198
const jl_to_r = Dict(
199
    "im"            =>  "i",
200
    "eu"            =>  "euler_gamma",
201
    "eulergamma"    =>  "euler_gamma",
202
    "golden"        =>  "golden_ratio",
203
    "Inf"           =>  "infinity"
204
)
205

206
const jl_to_r_utf = Dict(
207
    "π"             =>  "pi",
208
    "ℯ"             =>  "e",
209
    "MathConstants.γ"=> "euler_gamma",
210
    "MathConstants.φ"=> "golden_ratio"
211
)
212

213
const jl_to_r_ifx = Dict(
214
    "//"            =>  "/"
215
    #"\""            =>  "~"
216
)
217

218
"""
219
    list(r)
220

221
The operator `list` is an alternative to the usage of curly brackets. `list` accepts an arbitrary number of arguments and returns a list of its arguments. This operator is useful in cases where operators have to be passed as arguments. E.g.,
222
```Julia
223
julia> list(:a,list(list(:b,:c),:d),:e) == R"{{a},{{b,c},d},e}"
224
true
225
```
226
"""
227 28
list(r::T) where T <: Tuple = RExpr(r)
228 28
list(r::Array{RExpr,1}) = "{$(replace(join(split(join(r)).str,','),":="=>"="))}" |> RExpr
229 28
list(a::T) where T <: Vector = length(a)  0 ? list(lister.(a)) : R"{}"
230 0
list(a::T) where T <: Adjoint = list([a...])
231 0
list(a::T) where T <: Matrix = list([a[:,k] for k  1:size(a)[2]])
232 0
list(r...) = list(r)
233 28
lister(expr) = typeof(expr) <: Vector ? list(expr) : RExpr(expr)
234

235
export sub_list
236

237 4
function sub_list(syme::Dict{String,String})
238 28
    str = IOBuffer()
239 24
    write(str,"{")
240 24
    k = length(keys(syme))
241 28
    for key in keys(syme)
242 24
        k -= 1
243 28
        write(str,"$key => $(syme[key])")
244 28
        k > 0 && write(str,",")
245
    end
246 24
    write(str,"}")
247 28
    return String(take!(str))
248
end
249

250 28
_syme(syme::Dict{String,String}) = sub_list(syme)[2:end-1]
251

252 4
function _subst(syme::String,expr::T) where T
253 28
    convert(T, "!*hold($expr)\$ ws where $syme" |> rcall)
254
end
255

256
const symrjl = _syme(r_to_jl)
257
const symjlr = _syme(jl_to_r)
258
const reprjlu = r_to_jl_utf
259
const repjlru = jl_to_r_utf
260
reprjl = r_to_jl_ifx
261
const repjlr = jl_to_r_ifx
262
const gexrjl = Regex("($(join(keys(r_to_jl),")|(")))")
263
const gexjlr = Regex("($(join(keys(jl_to_r),")|(")))")
264

265
"""
266
    Reduce.Rational(::Bool)
267

268
Toggle whether to use '/' or '//' for division in julia expressions
269
"""
270 20
Rational = ( () -> begin
271 24
        gs = false
272 24
        return (tf=gs)->(gs≠tf && (gs=tf; reprjl["/"]=gs ? "//" : "/"); return gs)
273
    end)()
274

275
"""
276
    Reduce.SubCall(::Bool)
277

278
Toggle whether to substitute additional expressions
279
"""
280 20
SubCall = ( () -> begin
281 24
        gs = true
282 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
283
    end)()
284

285
"""
286
    Reduce.SubHold(::Real)
287

288
Sleep timer in case of clogged Reduce pipe on SubCall
289
"""
290 20
SubHold = ( () -> begin
291 24
        gs = 1/17
292 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
293
    end)()
294

295
"""
296
    Reduce.SubFail(::Integer)
297

298
Failure limit in case of clogged Reduce pipe on SubCall
299
"""
300 20
SubFail = ( () -> begin
301 24
        gs = 17
302 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
303
    end)()
304

305
"""
306
    Reduce.ColCheck(::Bool)
307

308
Toggle whether to reset REPL linewidth on each show
309
"""
310 20
ColCheck = ( () -> begin
311 24
        gs = true
312 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
313
    end)()
314

315
"""
316
    Reduce.PrintLog(::Bool)
317

318
Toggle whether to display the log of REDUCE commands
319
"""
320 20
PrintLog = ( () -> begin
321 24
        gs = false
322 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
323
    end)()
324

325
"""
326
    Reduce.ListPrint(::Int)
327

328
Toggle whether to translate assignment as `:=` or `=` for list parsing.
329
"""
330 20
ListPrint = ( () -> begin
331 24
        gs = 0
332 28
        return (tf=gs)->(gs≠tf && (gs=tf); return gs)
333
    end)()
334

335 4
@inline function SubReplace(sym::Symbol,str::String;utf=false)
336 28
    a = collect((m.match for m = eachmatch(r"([^ ()+*\^\/-]+|[()+*\^\/-])",str)))
337 28
    for s  1:length(a)
338 28
        if !isinfix(a[s]) && !occursin(r"[()]",a[s])
339 28
            if utf
340 28
                for key in keys(sym == :r ? reprjlu : repjlru)
341 28
                    if a[s] == key
342 28
                        a[s] = replace(a[s],key=>(sym == :r ? reprjlu[key] : repjlru[key]))
343
                    end
344
                end
345
            else
346 28
                if occursin(sym == :r ? gexrjl : gexjlr,a[s])
347 28
                    w = _subst(sym == :r ? symrjl : symjlr, a[s])
348 28
                    if w == ""
349 0
                        c = 1
350 0
                        f = SubFail()
351 0
                        h = SubHold()
352 0
                        while w == "" && c < f
353 0
                            sleep(sqrt(c)*h)
354 0
                            w = _subst(sym == :r ? symrjl : symjlr, a[s])
355 0
                            c += 1
356
                        end
357 0
                        PipeClogged(w  "", c, "substitution")
358
                    end
359 28
                    w  "" ? (a[s] = w) : (@info "If this is a recurring problem, try with `Reduce.SubCall(false)`.")
360
                end
361
            end
362 28
        elseif isinfix(a[s]) && utf
363 28
            if (s  length(a)) && (a[s+1] == a[s]) && (a[s]  ["*","/"])
364 24
                a[s] *= a[s+1]
365 24
                a[s+1] = ""
366
            end
367 28
            for key in keys(sym == :r ? reprjl : repjlr)
368 28
                if a[s] == key
369 28
                    a[s] = replace(a[s],key=>(sym == :r ? reprjl[key] : repjlr[key]))
370
                end
371
            end
372
        end
373 28
        if sym == :r
374 28
            a[s] == "inf" && (a[s] = "Inf")
375 28
            a[s] == " - inf" && (a[s] = "-Inf")
376 28
            (a[s] == "nan") | (a[s] == " - nan") && (a[s] = "NaN")
377
        end
378
    end
379 28
    return join(a)
380
end
381

382 4
@noinline function JSymReplace(str::String)
383 28
    str = SubReplace(:jl,str;utf=true)
384 28
    SubCall() && !isinfix(str) && (str = SubReplace(:jl,str;utf=false))
385 28
    occursin("!#",str) && (str = replace(rcall(str,:nat),r"\n"=>""))
386 28
    return str
387
end
388

389 4
@noinline function RSymReplace(str::String)
390 28
    clean = replace(str,r"[ ;\n]"=>"")
391 28
    paren = occursin(r"^\(((?>[^\(\)]+)|(?R))*\)$",clean)
392 28
    (isempty(clean)|(clean=="()")) && (return str)
393 28
    if SubCall() && !isinfix(str) && !occursin(str,".")
394 28
        str = SubReplace(:r,str;utf=false)
395
    end
396 28
    if occursin("!#",str)
397 12
        rsp = split(str,';')
398 14
        for h in 1:length(rsp)
399 12
            psr = split(rsp[h],'.')
400 2
            mod = false
401 14
            for k in 1:length(psr)
402 14
                if occursin("!#",psr[k])
403 12
                    sp = split(psr[k],r"!#")
404 14
                    psr[k] = join([sp[1],replace(rcall("!#"*sp[end]*";",:nat),r"\n"=>"")])
405 14
                    mod = true
406
                end
407
            end
408 14
            mod && (rsp[h] = join(psr))
409
        end
410 12
        str = join(rsp)
411
    end
412 28
    str = SubReplace(:r,str;utf=true)
413 28
    return paren ? "("*str*")" : str
414
end
415

416 28
RSymReplace(str::SubString{String}) = str |> String |> RSymReplace
417

418 28
convert(::Type{RExpr}, r::RExpr) = r
419 28
convert(::Type{Array{String,1}}, r::RExpr) = r.str
420 24
convert(::Type{String}, r::RExpr) = join(r.str,";\n")
421 28
convert(::Type{T}, r::RExpr) where T = T <: Number ? eval(parse(r)) : parse(r)
422 0
convert(::Type{Any}, r::RExpr) = r
423

424
"""
425
    rcall(r::RExpr)
426

427
Evaluate a Reduce expression.
428

429
## Examples
430
```julia-repl
431
julia> R\"int(sin(x), x)\" |> RExpr |> rcall
432
 - cos(x)
433
```
434
"""
435 4
@noinline function rcall(r::RExpr;
436
        on::Union{Array{Symbol,1},Array{String,1}}=Symbol[],
437
        off::Union{Array{Symbol,1},Array{String,1}}=Symbol[])
438 28
    typeof(on) == Array{String,1} ? (ona = Symbol.(on)) : (ona = on)
439 28
    typeof(off) == Array{String,1} ? (offa = Symbol.(off)) : (offa = off)
440 28
    ons = IOBuffer()
441 28
    onr = IOBuffer()
442 28
    offs = IOBuffer()
443 28
    offr = IOBuffer()
444 8
    mode = true
445 8
    trim = false
446 8
    expo = false
447 8
    rlfi = false
448 28
    for o in ona
449 28
        if o == :expand
450 24
            write(ons,"on exp\$ ")
451 28
            write(onr,"; off exp ")
452 28
        elseif o == :latex
453 28
            rcall(R"on latex")
454 28
            rlfi = true
455
        else
456 24
            write(ons,"on $o\$ ")
457 24
            write(onr,"; off $o ")
458
        end
459 28
        o == :factor && (expo = true)
460 28
        o in offa && throw(ReduceError("Invalid: switch on and off at once"))
461 28
        o in [:latex,:nat] && (mode = false)
462 28
        o == :nat && (trim = true)
463
    end
464 28
    for o in offa
465 28
        !(o == :factor) && write(offs,"off $o\$ ")
466 28
        !(o in [offlist;[:factor]]) && write(offr,"; on $o")
467
    end
468 28
    wrs = String(UInt8[take!(ons)...,take!(offs)...]) *
469
          string(r) *
470
          String(UInt8[take!(onr)...,take!(offr)...])
471 28
    PrintLog() && println(wrs)
472 28
    write(rs,wrs)
473 28
    sp = mode ? readsp(rs) : read(rs)
474 28
    expo && rcall(R"off exp")
475 28
    mode && for h  1:length(sp)
476 28
        sp[h] = replace(sp[h],'\n' => "")
477 28
        sp[h] = replace(sp[h],'\\' => "")
478
    end
479 28
    trim && (return join(split(sp,"\n")[2:end-1],'\n'))
480 28
    rlfi && rcall(R"off latex")
481 28
    for o in offa
482 28
        o == :nat && (return join(sp))
483 28
        o == :latex && popfirst!(sp)
484
    end
485 28
    return mode ? sp |> RExpr |> split : sp
486
end
487

488 28
rcall(r::RExpr,switches...) = rcall(r;on=[switches...])
489

490
"""
491
    rcall{T}(e::T)
492

493
Evaluate a Julia expression or string using the Reduce interpretor and convert
494
output back into the input type
495

496
## Examples
497
```julia-repl
498
julia> rcall(\"int(sin(y)^2, y)\")
499
\"( - cos(y)*sin(y) + y)/2\"
500

501
julia> rcall(:(int(1/(1+x^2), x)))
502
:(atan(x))
503
```
504
"""
505 4
function rcall(expr::T;on::Array{A,1}=Symbol[],off::Array{B,1}=Symbol[]) where T where A <: Union{Symbol,String} where B <: Union{Symbol,String}
506 28
    comp = rcall(RExpr(expr);on=on,off=off)
507 28
    (:latex in on) | (:nat in on) ? (return comp) : (return convert(T,comp))
508
end
509

510 4
macro rcall(r,on::Union{Array{Symbol,1},Array{String,1}}=Symbol[],off::Union{Array{Symbol,1},Array{String,1}}=Symbol[])
511 28
    return Expr(:quote,rcall(r.head == :quote ? r.args[1] : r; on=on,off=off))
512
end
513

514
macro rcall(r,switches...)
515
    Expr(:quote,rcall(r.head == :quote ? r.args[1] : r, switches...))
516
end
517

518 28
rcall(r,switches...) = rcall(r;on=Symbol.([switches...]))
519

520 4
function ==(r::RExpr, s::RExpr)
521 28
    n = expand(r).str
522 28
    m = expand(s).str
523 24
    l=length(n)
524 28
    l≠length(m) && (return false)
525 8
    b = true
526 28
    for j∈1:l
527 28
        b &= "if($(n[j]))=($(m[j]))then 1 else 0"|>rcall|>Meta.parse|>eval|>Bool
528
    end
529 28
    return b
530
end
531

532
#getindex(r::RExpr, i) = "$r($i)" |> rcall
533

534
#= regroup parens * add feature
535

536
@noinline function squash(expr)
537
    if typeof(expr) == Expr && expr.head ∈ [:block,:function]
538
        nex = deepcopy(expr)
539
        k = expr.head ≠ :function ? 1 : 2
540
        while k ≤ length(nex.args)
541
            found = false
542
            if typeof(nex.args[k]) == Expr &&
543
                    occursin(r"[*\/+-^]=$",string(nex.args[k].head))
544
                var = nex.args[k].args[1]
545
                for h ∈ 1:k-1
546
                    if typeof(nex.args[h]) == Expr &&
547
                            nex.args[h].head == :(=) &&
548
                            nex.args[h].args[1] == var
549
                        nex.args[h].args[2] = eval(Expr(:call,
550
                            Symbol(match(r"[^(=$)]",string(nex.args[k].head)).match),
551
                            QuoteNode(nex.args[h].args[2]),
552
                            QuoteNode(nex.args[k].args[2])))
553
                        deleteat!(nex.args,k)
554
                        found = true
555
                        break
556
                    end
557
                end
558
            else
559
                typeof(nex.args[k]) == Expr && (nex.args[k] = squash(nex.args[k]))
560
            end
561
            !found && (k += 1)
562
        end
563
        return length(nex.args) > 1 ? nex : nex.args[end]
564
    elseif typeof(expr)
565
    else
566
        return expr
567
    end
568
end=#
569

570
"""
571
    squash(expr)
572

573
Reduces an entire program statement block using symbolic rewriting
574
"""
575 4
function squash(expr)
576 28
    typeof(expr) == Expr && if expr.head == :block
577 28
        return @eval Reduce.Algebra $expr
578 28
    elseif expr.head == :function
579 24
        out = deepcopy(expr)
580 28
        out.args[2] = @eval Reduce.Algebra $(Expr(:block,expr.args[2]))
581 28
        return out
582
    else
583 28
        return rcall(expr)
584
    end
585
end

Read our documentation on viewing source code .

Loading