PART function (TI89, HPPRIME) for HP48/49/50

[compsystems]

sorry for my bad English

Hi I have managed create the same PART function (TI89, HPPRIME) for HP48/49/50 calculators, this function to extract each part of an expression, very useful to analyze the algebraic expression,

PART function SOURCE CODE: used as main function obj->

PHP Code:

« 0 0 { } -> EXPRESSION XPART NPARTS OPERATOR OBJECTS
  « EXPRESSION
    IFERR OBJ->
    THEN ->STR 'OPERATOR' STO 0 'NPARTS' STO OPERATOR 1 ->LIST 'OBJECTS' STO
    ELSE ->STR 'OPERATOR' STO 'NPARTS' STO NPARTS ->LIST 'OBJECTS' STO NPARTS OPERATOR OBJECTS 3 ->LIST DROP
    END
      IF XPART NPARTS <= XPART -1 >= AND NOT
      THEN "EXPRESSION " EXPRESSION + " CONTAINS ONLY " + NPARTS + " PARTS" +
      ELSE
        IF XPART 0 ==
        THEN OPERATOR
        ELSE
          IF XPART -1 ==
          THEN NPARTS
          ELSE OBJECTS XPART GET
          END
        END
      END
  »
»
'PART' STO 


Syntax:
part(Expr, Integer)

Returns the nth sub expression of an expression. If the second argument is empty (-1 for hp48/49/50), returns the number of parts.
If the second argument is ZERO, returns the operator if any, otherwise returns the same expression as string


Examples:
TI89/TIVOYAGE200PLT AND HPPRIME

part(sin(x)+cos(y)) → 2 // two parts sin(x) & cos(y)
part(sin(x)+cos(y),1) → sin(x) // first part
part(sin(x)+cos(y),2) → cos(y) // second part
part(sin(x)+cos(y),3) → "nonexistent part in the expression"
part(sin(x)+cos(y),0) → "+" // operator between parts

part( part(sin(x)+cos(y),1)) → 1 // number of parts of the first part
part( part(sin(x)+cos(y),2)) → 1 // number of parts of the second part

part( part(sin(x)+cos(y),1),1) → x // firts part of the firts part, sin(x)→ x
part( part(sin(x)+cos(y),2),1) → y // firts part of the second part, cos(y)→ y

part( part(sin(x)+cos(y),1),0) → "sin" // operator of the firts part, sin(x)→ "sin"
part( part(sin(x)+cos(y),2),0) → "cos" // operator of the second part, cos(x)→ "cos"


part(sin(x)) → 1 // one part
part(sin(x),1) → x // first part
part(sin(x),0) → "sin" // operator "sin"

part(part(exp(x)*sin(x) + cos(x),1),2) → sin(x) // second part of the first part exp(x)*sin(x) → sin(x)
part(part(exp(x)*sin(x) + cos(x),1),0) → "*" // operator of the first part exp(x)*sin(x) → "*"
part(part(exp(x)*sin(x) + cos(x),2),0) → "cos" // operator of the second part cos(x)→ "cos"
part(part(exp(x)*sin(x) + cos(x),2),1) → "x"
part(part(exp(x)*sin(x) + cos(x),1)) → 2
part(part(exp(x)*sin(x) + cos(x),1),1) → exp(x)
part(part(part(e^x*sin(x) + cos(x),1),1),1) → x
part(part(part(e^x*sin(x) + cos(x),1),1),0) → "exp"

special cases

part(-X) → 1 // one parts
part(-X,1) → 1 // firts part, X
part(-X,0) → 1 // operator "-"

part(X1) → 0 // No parts
part(X1,0) → "X1"

part(-1) → 0 // No parts
part(-X,0) → 1 // "-1"
--------------

hp48/49/50 SERIES

'sin(x)+cos(x))' -1 → 2 // 2 parts
'sin(x)+cos(x)' 0 → "+" // operator
'sin(x)+cos(x)' 1 → 'sin(x)' // part1
'sin(x)+cos(x)' 2 → 'cos(x)' // part2
'sin(x)+cos(x)' 3 → "nonexistent part in the expression"


application of the PART function

TI89 Code

PHP Code:

difstep(f,x)
Func
  //f(x),x
  Local op
  //diff(x,x)
  If getType(f)="VAR"
    Return when(f=x,1,0,0)
  part(f,0)->op
  //diff(k,x)
  If part(f)=0
    Return 0
  //diff(­f,x)
  If op="­"
    Return ­1*difstep(part(f,1),x)
  //diff(x^n,x)
  If op="^"
    Return part(f,2)*part(f,1)^(part(f,2)-1)
  //diff(v(x),x)
  If op="sqroot"
    Return 1/(2*sqroo(part(f,1)))
  //diff(f+g,x)
  If op="+"
    Return difstep(part(f,1),x)+difstep(part(f,2),x)
  //diff(f-g,x)
  If op="-"
    Return difstep(part(f,1),x)-difstep(part(f,2),x)
  //diff(f*g,x)
  If op="*"
    Return part(f,1)*difstep(part(f,2),x)+part(f,2)*difstep(part(f,1),x)
  //diff(f/g,x)
  If op="/"
    Return (part(f,2)*difstep(part(f,1),x)-part(f,1)*difstep(part(f,2),x))/part(f,2)^2
...
  Return undef
EndFunc 


hpprime example


One way to make a Derivative is through tables rather by a selection of cases, analyzing the parts of the expression

PHP Code:

// version 0.2 Jun 6 2016 by COMPSYSTEMS COPYLEFT inv(©)
#cas
diff_table(xpr,var):=
BEGIN
    LOCAL nparts, operator, part1, part2;
    LOCAL xprSameVar;
    //purge(var);
    //print("");
    //CASE 1: if the expression is a variable name or identifier
    if (type(xpr)==DOM_IDENT) then
        // CASE 2: if the expression is equal to the variable, example diff(x,x)=1, otherwise diff(x,y)=0
        return when(xpr==var,1,0);
    end;
    // number of parts of the expression
    nparts:=part(xpr);
    //operator
    operator:=part(xpr,0);
    //CASE 3: diff(k,v)=0
    //print(nparts); print(operator); wait;
    if (nparts==0) then
        return 0; // xpr=pi, i, numbers
    end;
    if (nparts>1) then
        part1:=part(xpr,1);
        part2:=part(xpr,2);
        //print(part1);print(part2);wait;
        else
        part1:=part(xpr,1);
        //print(part1); wait;
    end;
    
    xprSameVar:= (string(part1)==string(var));
    
    //CASE 4: diff(-f(v),v)=0 // NEG(xpr)
    if (operator=="-") then
        return -1*diff_table(part1,var);
    end;
    //CASE 5: diff(k*f(v),v)=0 // NEG(xpr)
    if (operator="*" and type(part1)==DOM_INT) then
        return part1*diff_table(part2,var);
    end;
    //CASE 6: diff(|f(v)|,v) with f(v)=v
    if (operator=="abs" and xprSameVar) then
        return sign(var); // assuming a function from R -> R
        //return var/abs(var); // Alternate Form
    end;
    //CASE 7: diff(|f(v)|,v)
    if (operator=="abs" and !(xprSameVar)) then
        return sign(var)*diff_table(part1,var);
    end;
    //         //CASE 8: diff(√(f(v)),v)
    //         if operator=="√" and xprSameVar then
    //             return 1/(2*√(var));
    //         end;
    //         //CASE 9: diff(√(v),v)
    //         if operator=="√" and !(xprSameVar) then
    //             return diff_table(part1,var)/(2*√(var));
    //         end;
    
    //CASE 8: diff(ln(v),v)
    if (operator=="ln" and xprSameVar) then
        return 1/var;
    end;
    //CASE 9: diff(ln(f(v)),v)
    if (operator=="ln" and !(xprSameVar)) then
        return diff_table(part1,var)/part1;
    end;
    //fun.trig
    //CASE 10: diff(sin(v),v)
    if (operator="sin" and xprSameVar) then
        return cos(var);
    end;
    //CASE 11: diff(sin(f(v)),v)
    if (operator="sin" and !(xprSameVar)) then
        return cos(part1)*diff_table(p1,var);
    end;
    //CASE 12: diff(cos(v),v)
    if (operator="cos" and xprSameVar) then
        return ­sin(var);
    end;
    //CASE 13: diff(cos(f(v)),v)
    if (operator="cos" and !(xprSameVar)) then
        return ­sin(part1)*diff_table(part1,var);
    end;
    //CASE 14: diff(tan(v),v)
    if (operator="tan" and xprSameVar) then
        return sec(var)^2 ; // alternate form (1/cos(x))^2
    end;
    //CASE 15: diff(tan(f(v)),v)
    if (operator="tan" and !(xprSameVar)) then
        return sec(part1)^2*diff_table(part1,var);
    end;
    //CASE 16: diff(sin^-1(v),v)
    if (operator=="asin" and xprSameVar) then
        return 1/√(1-var^2);
    end;
    //CASE 17: diff(sin^-1(f(v)),v)
    if (operator=="asin" and !(xprSameVar)) then
        return diff_table(part1,var)/√(1-part1^2);
    end;
    //CASE 18: diff(cos^-1(v),v)
    if (operator=="acos" and xprSameVar) then
        return ­1/√(1-var^2);
    end;
    //CASE 19: diff(cos^-1(f(v)),v)
    // acos(-x) -> ((π+2*asin(x))/2)
    //     if (operator=="acos" and !(xprSameVar)) then
    //         return -1*diff_table(part1,var)/√(1-part1^2);
    //     end;
    //CASE 20: diff(atan^-1(v),v)
    if (operator=="atan" and xprSameVar) then
        return 1/(1+var^2);
    end;
    //CASE 21: diff(atan^-1(f(v)),v)
    if (operator=="atan" and !(xprSameVar)) then
        return diff_table(part1,var)/(1+part1^2);
    end;
    
    //CASE  : diff(f+g,v)
    if operator="+" then
        return deriv(part1,var)+deriv(part2,var);
    end;
    
    // codifying
    // ...
    return Done;
END;
#end 


Examples

CASE 1:
diff_table(x,x) -> 1

CASE 2:
diff_table(x,y) -> 0
diff_table(y,x) -> 0

CASE 3:
diff_table(i,x) -> 0
diff_table(√(-1),x) -> 0
diff_table(5,x) -> 0
diff_table(PI,x) -> 0
diff_table(-1,x) -> 0

CASE 4:
diff_table(-x,x) -> -1

CASE 5:
diff_table(-3*x,x) -> -3
diff_table(3*x,x) -> 3
diff_table(+3*x,x) -> 3

CASE 6:
diff_table(abs(x),x) -> sign(x)

CASE 7:
diff_table(abs(-x),x) -> sign(x)

CASE 8:
diff_table(ln(x),x) -> 1/x

CASE 9:
diff_table(ln(-x),x) -> 1/x

CASE 10:
diff_table(sin(x),x) -> cos(x)

CASE 11:
diff_table(sin(-x),x) -> -cos(x)

CASE 12:
diff_table(cos(x),x)­ -> ­-sin(x)

CASE 13:
diff_table(cos(x),x)­ -> ­-sin(x)

CASE 14:
diff_table(tan(x),x)-> (1/cos(x))^2 = sec(x)^2

CASE 15:
diff_table(tan(-x),x)-> -(1/cos(x))^2 = -sec(x)^2

CASE 16:
diff_table(asin(x),x) -> 1/√(1-x^2)

CASE 17:
diff_table(asin(x),x) -> -1/√(1-x^2)

CASE 18:
diff_table(acos(x),x) -> -­1/√(1-x^2)



CASE 20:
diff_table(atan(x),x) -> 1/(1+x^2)

CASE 21:
diff_table(atan(-x),x) -> -1/(1+x^2)

CASE ...:
writing ...

[Gilles]

By the way, why not use the OBJ-> command for this ?

Exemple

'SIN(x)+COS(y)' OBJ->

returns on the stack:

4 : 'SIN(x)'
3 : 'COS(y)'
2: 2.
1: +


'SIN(x)' OBJ->

returns on the stack:

3 : 'x'
2: 1.
1: SIN

I think it will be more powerfull and quicker

About your 'dérivative' examples I think you could use the MATCH commands wich are very powerfull and quite 'automatic' for this

AUR :

"Match Pattern Down Command: Rewrites an expression that matches a specified pattern. ↓MATCH rewrites expressions or subexpressions that match a specified pattern 'symbpat'. An optional condition, 'symbcond', can further restrict whether a rewrite occurs. A test result is also returned to indicate if command execution produced a rewrite; 1 if it did, 0 if it did not.


The pattern 'symbpat' and replacement 'symbrepl' can be normal expressions; for example, you can replace .5 with 'SIN(π/6)'. You can also use a “wildcard” in the pattern (to match any subexpression) and in the replacement (to represent that expression).

A wildcard is a name that begins with &, such as the name '&A', used in replacing 'SIN(&A+&B)' with 'SIN(&A)*COS(&B)+COS(&A)*SIN(&B)'.

Multiple occurrences of a particular wildcard in a pattern must match identical subexpressions."

Example 1: .5 { .5 'SIN(π/6)' } ↓MATCH
returns
'SIN(π/6)' to level 2 and 1 to level 1.

Example 2: 'SIN(U+V)' { 'SIN(&A+&B)'
'SIN(&A)*COS(&B)+COS(&A)*SIN(&B)' } ↓MATCH
returns
'SIN(U)*COS(V)+COS(U)*SIN(V)' to level 2 and 1 to level 1.

Example 3: This sequence: 'SIN(5*Z)' { 'SIN(&A+&B)'
'Σ(K=0,&A,COMB(&A,K)*SIN(K*π)*COS(&B^(&A-K)*SIN(&B)^K)'
'ABS(IP(&A))==&A' } ↓MATCH
returns
'Σ(K=0,5,COMB(5,K)*SIN(K*π)*COS(Z^(5-K)*SIN(Z)^K)' to level 2
and 1 to level 1.