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"(? 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 .