Tcl: Սիմվոլիկ դիֆերենցում

Մի քանի օր առաջ թերթում էի Structure and Interpretation of Computer Programs գիրքը և աչքովս ընկավ մի օրինակ, որտեղ հաշվում էր պարզագույն մաթեմատիկական արտահայտությունների դիֆերենցիալը (2.3.2 Example: Symbolic Differentiation)։ Փորձեցի այն վերարտադրել Tcl լեզվով ու ահա թե ինչ ստացվեց։

Նախապես ասեմ, որ արտահայտություները սահմանափակված են միայն գումարում, հանում, բազմապատկում և բաժանում բինար գործողություններով, իսկ դիֆերենցիալը հաշվող differentiate ֆունկցիան սպասում է, որ իր մուտքին տվելու է արտահայտության պրեֆիքսային ներկայացումն ու այն փոփոխականը, ըստ որի կատարվում է դիֆերենցումը։

Արտահայտությունների դիֆերենցիալը հաշվելու համար օգտագործվում են հետևյալ բանաձևերը.

1. \(C\) հաստատունի համար. \[\frac{dC}{dx}=0,\]
2. \(x\) փոփոխականի համար. \[\frac{dx}{dx}=1,\]
3. \(u+v\) գումարի համար. \[\frac{d(u+v)}{dx}=\frac{du}{dx}+\frac{dv}{dx},\]
4. \(u\cdot v\) արտադրյալի համար. \[\frac{d(uv)}{dx}=\frac{du}{dx}v+\frac{dv}{dx}u,\]
5. \(\frac{u}{v}\) քանորդի համար. \[\frac{d}{dx}\Big(\frac{u}{v}\Big)=\frac{\frac{du}{dx}v-\frac{dv}{dx}u}{v^2},\]

differentiate ռեկուրսիվ պրոցեդուրայում պարզապես ծրագրավորված են նշված բանաձևերը։

proc differentiate { src var } {
  set H [lindex $src 0]
  # constant 
  if [regexp {\d+} $H] {
    return 0
  }
  # variable
  if [regexp {\w[\w\d]*} $H] {
    if [string equal $H $var] {
      return 1
    } else {
      return 0
    }
  }
  # addition, subtraction
  if [regexp {(\+|\-)} $H] {
    set L [differentiate [lindex $src 1] $var]
    set R [differentiate [lindex $src 2] $var]
    return [addi $H $L $R]
  }
  # multiplication, division
  if [regexp {(\*|\/)} $H] {
    set A [lindex $src 1]
    set B [lindex $src 2]
    set L [muli "*" [differentiate $A $var] $B]
    set R [muli "*" [differentiate $B $var] $A]
    if [string equal {*} $H] {
      return [addi "+" $L $R]
    }
    return [muli "/" [addi "-" $L $R] [muli "*" $B $B]]
  }
}

Բացի դիֆերենցիալի հաշվումից այս պրոցեդուրան կատարում է նաև մի քանի պարզեցումներ՝ հաշվի առնելով, որ \(0\cdot x=0\), \(1\cdot x=x\) և \(0 + x=x\)։ Այս պարզեցումները կատարվում են addi, muli և numeq պրոցեդուրաներով։

proc numeq { n v } {
  if [regexp {^\d+$} $n] { 
    return [expr $n == $v]
  }
  return false
}

proc addi { o a b } {
  if [numeq $a 0] { return $b }
  if [numeq $b 0] { return $a }
  if {[regexp {^\d+$} $a] && [regexp {^\d+$} $b]} {
    return [expr $a $o $b]
  }
  return [list $o $a $b]
}

proc muli { o a b } {
  if {[numeq $a 0] || [numeq $b 0]} { return 0 }
  if [numeq $a 1] { return $b }
  if [numeq $b 1] { return $a }
  if {[regexp {^\d+$} $a] && [regexp {^\d+$} $b]} {
    return [expr $a $o $b]
  }
  return [list $o $a $b]
}

* * *
Սա շատ լավ է։ Կարելի է կառուցել արտահայտությունների պրեֆիքսային ներկայացման օրինակներ և համոզվել, որ differentiate պրոցեդուրան իր անելիքն անում է։ Բայց հետաքրքիր խնդիր է նաև ինֆիքսային գրառմամբ տրված արտահայտությունից պրեֆիքսային տեսքը կառուցելը։ Այդ խդիրը լուծելու համար ես գրել եմ ստանդարտ շարահյուսական անալիզատոր, որը կառուցում է տրված արտահայտության աբստրակտ քերականական ծառը Tcl լեզվի ցուցակի տեսքով, որն էլ հենց արտահայտության պրեֆիքսային ներկայացում է։ Ահա այդ կոդը.

namespace eval Parser {
  variable tokens [list]
  variable position -1
  variable current {}

  # սա կարելի է ասել, որ լեքսիկական անալիզատորն է
  proc tokenizer { src } {
    set temp [regsub -all -- {(\+|\-|\*|\/|\(|\))} $src { \1 }]
    set temp [string trim [regsub -all -- {\s+} $temp { }]]
    return [split $temp { }]
  }

  # ստուգում է հերթական սիմվոլը, և եթե այն համաատասխանում է 
  # սպասվածին, ապա փոխարինում է հաջորդով, հակառակ դեպքում 
  # գեներացնում է քերականական սխալ
  proc next { tok } {
    variable tokens
    variable current
    variable position
    if [regexp $tok $current] {
      incr position
      set current [lindex $tokens $position]
    } else {
      error "Syntax error"
    }
  }

  # վերլուծում է գումարման ու հանման գործողությունները
  proc parseExpr { } {
    variable current
    set R [parseTerm]
    while {({+} eq $current) || ({-} eq $current)} {
      set op $current
      next {[\+\-]}
      set R [list $op $R [parseTerm]]
    }
    return $R
  }

  # վերլուծում է բազմապատկման ու բաժանման գործողությունները
  proc parseTerm { } {
    variable current
    set R [parseFactor]
    while {({*} eq $current) || ({/} eq $current)} {
      set op $current
      next {[\*\/]}
      set R [list $op $R [parseFactor]]
    }
    return $R
  }

  # վերլուծում է հաստատունները, փոփոխականները և 
  # խմբավորման փակագծերը
  proc parseFactor { } {
    variable current
    set res {}
    if [regexp {[0-9]+} $current] {
      set res $current
      next {[0-9]+}
    } elseif [regexp {\w[\w\d]*} $current] {
      set res $current
      next {\w[\w\d]*}
    } elseif [string equal {(} $current] {
      next {[\(]}
      set res [parseExpr]
      next {[\)]}
    }
    return $res
  }

  # այս պրոցեդուրայից է սկսվում անալիզատորի աշխատանքը,
  # այն ստանում է արտահայտության տեքստը, վերլուծում է ու
  # վերադարձնում է նրա պրեֆիքսային ներկայացումը
  proc parse { src } {
    variable tokens
    variable position
    variable current
    set tokens [tokenizer $src]
    lappend tokens EOS
    set position -1
    set current {}
    next {}
    return [parseExpr]
  }
}

* * *
prefixToInfix պրոցեդուրան լուծում է հակառակ խնդիրը։ Այն իր արգումենտում ստանում է արտահայտության պրեֆիքսային ներկայացումը և վերադարձնում է ինֆիքսայինը։ Այս տարբերակով, իհարկե, այն արտահայտության մեջ դնում է ավելորդ փակագծեր, բայց այդ թերությունը հեշտությամբ կարելի է շտկել։

proc prefixToInfix { exp } {
  set H [lindex $exp 0]
  if [regexp {^\d+$} $H] {
    return $H
  }
  if [regexp {\w[\w\d]*} $H] {
    return $H
  }
  if [regexp {(\+|\-|\*|\/)} $H _ op] {
    set L [prefixToInfix [lindex $exp 1]]
    set R [prefixToInfix [lindex $exp 2]]
    return "($L $op $R)"
  }
}