how to simplify / expand / apply a pattern to a function's argument - wolfram-mathematica

(I made some changes...)
very often I want to simplify the function's argument, or apply a pattern to it, eg. I want to change:
Exp[a(b+c)]
into
Exp[a b + a c]
simple pattern doesn't help:
Sin[a(b+c)] /. Sin[aaa_] -> Sin[Expand[aaa]]
gives again
Sin[a(b+c)]
However, with functions other than Simplify / Expand it seems to do what I expect:
Sin[a (b + c)] /. Sin[aaa_] -> Sin[f[aaa]]
gives
Sin[ f[a(b+c)] ]
My usual solution was to use 2 patterns and Hold:
(Exp[a(b+c)] /. Exp[aaa_] -> Exp[Hold[ Expand[aaa] ]] ) /. Hold[xxx_] -> xxx
which results in
E^(a*b + a*c)
The disadvantage of this method is that code gets more complicated than it's neccesary.
MY REAL LIFE EXAMPLE is:
ppp2 =
( ppp1
/. { ExpIntegralEi[aaa_] ->
ExpIntegralEi[Hold[aaa /. { u2 -> 0, w2 -> 0, u3 -> x, w3 -> x}]],
Log[aaa_] ->
Log[Hold[aaa /. {u2 -> 0, w2 -> 0, u3 -> x, w3 -> x}]]
}
) /. Hold[xxx_] -> xxx;
where ppp1 is a long sum of terms containing u2, w2, u3, w3 and so on. I want to change the values of u, w2... ONLY in ExpIntegral and Log.
My other solution is a function:
ExpandArgument[expr_, what_] := Module[{list},
list = Extract[expr, Position[ expr, what[_] ]];
list = Map[Rule[#, what[Expand[ #[[1]] ]]] &, list];
Return[expr /. list]
]
The function I wrote can be easily generalised to make it possible to use not only Expand but also Simplify and so on:
ApplyToArgument[expr_, ToWhat_, WhatFunction_] := Module[{list},
list = Extract[expr, Position[ expr, ToWhat[_] ]];
list = Map[Rule[#, ToWhat[WhatFunction[ #[[1]] ]]] &, list];
Return[expr /. list]
]
For example:
ApplyToArgument[Sin[a (b + c)], Sin, Expand]
gives
Sin[a b + a c]
and
ApplyToArgument[Sin[a b + a c ], Sin, Simplify]
gives
Sin[a (b + c)]
This solution is easy to read but needs some refinement before being applied to many-argument functions (and I need these functions).
I guess I'm missing something fundamental about patterns in mathematica... How should I apply patterns to arguments of functions? (Or simplify, expand, etc. them)
Thanks a lot!

For the first part of the question, you could consider using RuleDelayed:
Sin[a (b + c)] /. Sin[aaa_] :> Sin[Expand[aaa]]
gives
Sin[a b + a c]

Use :> instead of ->. With ->, the right hand side is immediately evaluated, and only then applied. Expansion of aaa of course gives just aaa, and therefore evaluation of Sin[Expand[aaa]] gives Sin[aaa], thus the rule asks for replacing each application of Sin by itself. Then you also should not need those Hold constructs.
In a related note: Instead of applying the rule Hold[xxx_]->xxx, you can just pass your expression to ReleaseHold, for example ReleaseHold[Hold[1+1] /. 1->2] gives 4.

Also consider using ExpandAll:
ExpandAll[Exp[a (b + c)]] // FullForm
will give:
Power[E, Plus[Times[a, b], Times[a, c]]]
(This will turn Exp[...] into E^... though)

This is not a direct answer (others provided that), but for these kinds of manipulations the Algebraic Manipulation Palette (Palettes -> Other) is often quite convenient:
The disadvantage is that unlike typed-in commands, this operation won't be "recorded" and saved in the notebook.

Related

Stop evaluating an built-in Mathematica function

I am trying to simplify some formulas like
F[a,b,c]*F[a,c,b]+F[c,a,b] /. {a->1,b->2,c->3}
where
F[a,b,c] := LegendreP[a,x]+LegendreP[b,x]*LegendreP[c,x]
And Mathematica can give a polynomial of x.
But I would like to keep all LegendreP instead of expanding it. By setting the HoldAll attribute of LegendreP, I can stop this, but the arguments are also kept, which is not intended.
Could anyone give some advice to solve this problem? Thanks.
Edited: I would like to have a result like this for the above formula (where L=LegendreP)
L[3,x]+L[1,x]*L[2,x]+L[1,x]*L[1,x]+L[3,x]*L[2,x]*L[1,x]+L[1,x]*L[2,x]*L[3,x]+L[‌​3,x]*L[2,x]*L[2,x]*L[3,x]
But I would like to keep all LegendreP instead of expanded it.
Can't you use HoldForm?
F[a_, b_, c_] := HoldForm[LegendreP[a, x] + LegendreP[b, x]*LegendreP[c, x]];
F[a, b, c]*F[a, c, b] + F[c, a, b] /. {a -> 1, b -> 2, c -> 3}
ReleaseHold[%]
Simplify[%]
without knowing fully what you are trying to accomplish, one approach is to simply use some other symbol, eg:
F[a,b,c] := legendreP[a,x]+legendreP[b,x]*legendreP[c,x]
(note the lower case "l" )
When you get to the stage where you want evaluation apply a pattern substitution:
expr /. legendreP->LegendreP

Uncertainty propagation formula in mathematica

I'm trying to write a short piece of code that will perform propagation of errors. So far, I can get Mathematica to generate the formula for the error delta_f in a function f(x1,x2,...,xi,...,xn) with errors dx1,dx2,...,dxi,...dxn:
fError[f_, xi__, dxi__] :=
Sum[(D[f[xi], xi[[i]]]*dxi[[i]])^2, {i, 1, Length[xi]}]^(1/2)
where fError requires that the input function f has all of its variables surrounded by {...}. For example,
d[{mv_, Mv_, Av_}] := 10^(1/5 (mv - Mv + 5 - Av))
FullSimplify[fError[d, {mv, Mv, Av}, {dmv, dMv, dAv}]]
returns
2 Sqrt[10^(-(2/5) (Av - mv + Mv)) (dAv^2 + dmv^2 + dMv^2)] Log[10]
My question is, how can I evaluate this? Ideally I would like to modify fError to something like:
fError[f_, xi__, nxi__, dxi__]
where nxi is the list of actual values of xi (separated since setting the xi's to their numerical values will destroy the differentiation step above.) This function should find the general formula for the error delta_f and then evaluate it numerically, if possible. I think the solution should be as simple as a Hold[] or With[] or something like that, but I can't seem to get it.
I'm not following everything that you've done, and since this was posted two years ago it's likely you aren't working on it anymore anyways. I'll give you my solution for error propagation in hopes that it will somehow help you or others.
I tried to include the best documentation that I could in the video and files linked below. If you open the .cdf file and weed through it you should be able to see my code...
Files:
https://drive.google.com/file/d/0BzKVw6gFYxk_YUk4a25ZRFpKaU0/view?pli=1
Video Tutorial:
https://www.youtube.com/watch?v=q1aM_oSIN7w
-Brian
Edit:
I posted the links because I couldn't attach files and didn't want to post code with no documentation for people new to mathematica. Here's the code directly. I would encourage anyone finding this solution helpful to take a quick look at the documentation because it demonstrates some tricks to improve productivity.
Manipulate[
varlist = ToExpression[variables];
funct = ToExpression[function];
errorFunction[variables, function]
, {variables, "{M,m}"}, {function, "g*(M-m)/(M+m)"},
DisplayAllSteps -> True, LabelStyle -> {FontSize -> 17},
AutoAction -> False,
Initialization :> (
errorFunction[v_, f_] := (
varlist = ToExpression[v];
funct = ToExpression[f];
varlength = Length[Variables[varlist]];
theoretical =
Sqrt[(Total[
Table[(D[funct, Part[varlist, n]]*
Subscript[U, Part[varlist, n]])^2, {n, 1,
varlength}]])];
Part[theoretical, 1];
varlist;
uncert = Table[Subscript[U, Part[varlist, n]], {n, 1, varlength}];
uncert = DeleteCases[uncert, Alternatives ## {0}];
theoretical = Simplify[theoretical];
Column[{Row[{Grid[{
{"Variables", varlist},
{"Uncertainties", uncert},
{"Function", function},
{"Uncertainty Function", theoretical}}, Alignment -> Left,
Spacings -> {2, 1}, Frame -> All,
ItemStyle -> {"Text", FontSize -> 20},
Background -> {{LightGray, None}}]}],
Row[{
Grid[{{"Brian Gennow March/24/2015"}}, Alignment -> Left,
Spacings -> {2, 1}, ItemStyle -> "Text",
Background -> {{None}}]
}]}]))]
This question was posted over 5 years ago, but I ran into the same issue recently and thought I'd share my solution (for uncorrelated errors).
I define a function errorProp that takes two arguments, func and vars. The first argument of errorProp, func, is the symbolic form of the expression for which you wish to calculate the error of its value due to the errors of its arguments. The second argument for errorProp should be a list of the form
{{x1,x1 value, dx1, dx1 value},{x2,x2 value, dx2, dx2 value}, ... ,
{xn,xn value, dxn, dxn value}}
Where the xi's and dxi's are the symbolic representations of the variables and their errors, while the xi value and dxi value are the numerical values of the variable and its uncertainty (see below for an example).
The function errorProp returns the symbolic form of the error, the value of the input function func, and the value of the error of func calculated from the inputs in vars. Here is the code:
ClearAll[errorProp];
errorProp[func_, vars_] := Module[{derivs=Table[0,{Length[vars]}],
funcErrorForm,funcEval,funcErrorEval,rplcVals,rplcErrors},
For[ii = 1, ii <= Length[vars], ii++,
derivs[[ii]] = D[func, vars[[ii, 1]]];
];
funcErrorForm = Sqrt[Sum[(derivs[[ii]]*vars[[ii, 3]])^2,{ii,Length[vars]}]];
SetAttributes[rplcVals, Listable];
rplcVals = Table[Evaluate[vars[[ii, 1]]] :> Evaluate[vars[[ii, 2]]], {ii,
Length[vars]}];
SetAttributes[rplcErrors, Listable];
rplcErrors = Table[Evaluate[vars[[ii, 3]]] :> Evaluate[vars[[ii, 4]]], {ii,
Length[vars]}];
funcEval = func /. rplcVals;
funcErrorEval = funcErrorForm /. rplcVals /. rplcErrors;
Return[{funcErrorForm, funcEval, funcErrorEval}];
];
Here I show an example of errorProp in action with a reasonably complicated function of two variables:
ClearAll[test];
test = Exp[Sqrt[1/y] - x/y];
errorProp[test, {{x, 0.3, dx, 0.005}, {y, 0.9, dy, 0.1}}]
returns
{Sqrt[dy^2 E^(2 Sqrt[1/y] - (2 x)/y) (-(1/2) (1/y)^(3/2) + x/y^2)^2 + (
dx^2 E^(2 Sqrt[1/y] - (2 x)/y))/y^2], 2.05599, 0.0457029}
Calculating using the error propagation formula returns the same result:
{Sqrt[(D[test, x]*dx)^2 + (D[test, y]*dy)^2],
test /. {x :> 0.3, dx :> 0.005, y :> 0.9, dy :> 0.1},
Sqrt[(D[test, x]*dx)^2 + (D[test, y]*dy)^2] /. {x :> 0.3,
dx :> 0.005, y :> 0.9, dy :> 0.1}}
returns
{Sqrt[dy^2 E^(
2 Sqrt[1/y] - (2 x)/y) (-(1/2) (1/y)^(3/2) + x/y^2)^2 + (
dx^2 E^(2 Sqrt[1/y] - (2 x)/y))/y^2], 2.05599, 0.0457029}
Mathematica 12 introduced the Around function that handles error propagation using the differential method.
So although not quite in the format required in the question, but something like this is possible:
expression = a^2*b;
expression /. {a -> Around[aval, da], b -> Around[bval, db]}
output:
aval^2 bval ± Sqrt[aval^4 db^2+4 bval^2 Abs[aval da]^2]
Instead of aval, bval, da, db you can use numerical values as well.

Addition of Functions

So generally, if you have two functions f,g: X -->Y, and if there is some binary operation + defined on Y, then f + g has a canonical definition as the function x --> f(x) + g(x).
What's the best way to implement this in Mathematica?
f[x_] := x^2
g[x_] := 2*x
h = f + g;
h[1]
yields
(f + g)[1]
as an output
of course,
H = Function[z, f[z] + g[z]];
H[1]
Yields '3'.
Consider:
In[1]:= Through[(f + g)[1]]
Out[1]= f[1] + g[1]
To elaborate, you can define h like this:
h = Through[ (f + g)[#] ] &;
If you have a limited number of functions and operands, then UpSet as recommended by yoda is surely syntactically cleaner. However, Through is more general. Without any new definitions involving Times or h, one can easily do:
i = Through[ (h * f * g)[#] ] &
i[7]
43218
Another way of doing what you're trying to do is using UpSetDelayed.
f[x_] := x^2;
g[x_] := 2*x;
f + g ^:= f[#] + g[#] &; (*define upvalues for the operation f+g*)
h[x_] = f + g;
h[z]
Out[1]= 2 z + z^2
Also see this very nice answer by rcollyer (and also the ones by Leonid & Verbeia) for more on UpValues and when to use them
I will throw in a complete code for Gram - Schmidt and an example for function addition etc, since I happened to have that code written about 4 years ago. Did not test extensively though. I did not change a single line of it now, so a disclaimer (I was a lot worse at mma at the time). That said, here is a Gram - Schmidt procedure implementation, which is a slightly generalized version of the code I discussed here:
oneStepOrtogonalizeGen[vec_, {}, _, _, _] := vec;
oneStepOrtogonalizeGen[vec_, vecmat_List, dotF_, plusF_, timesF_] :=
Fold[plusF[#1, timesF[-dotF[vec, #2]/dotF[#2, #2], #2]] &, vec, vecmat];
GSOrthogonalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Fold[Append[#1,oneStepOrtogonalizeGen[#2, #1, dotF, plusF, timesF]] &, {}, startvecs];
normalizeGen[vec_, dotF_, timesF_] := timesF[1/Sqrt[dotF[vec, vec]], vec];
GSOrthoNormalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Map[normalizeGen[#, dotF, timesF] &, GSOrthogonalizeGen[startvecs, dotF, plusF, timesF]];
The functions above are parametrized by 3 functions, realizing addition, multiplication by a number, and the dot product in a given vector space. The example to illustrate will be to find Hermite polynomials by orthonormalizing monomials. These are possible implementations for the 3 functions we need:
hermiteDot[f_Function, g_Function] :=
Module[{x}, Integrate[f[x]*g[x]*Exp[-x^2], {x, -Infinity, Infinity}]];
SetAttributes[functionPlus, {Flat, Orderless, OneIdentity}];
functionPlus[f__Function] := With[{expr = Plus ## Through[{f}[#]]}, expr &];
SetAttributes[functionTimes, {Flat, Orderless, OneIdentity}];
functionTimes[a___, f_Function] /; FreeQ[{a}, # | Function] :=
With[{expr = Times[a, f[#]]}, expr &];
These functions may be a bit naive, but they will illustrate the idea (and yes, I also used Through). Here are some examples to illustrate their use:
In[114]:= hermiteDot[#^2 &, #^4 &]
Out[114]= (15 Sqrt[\[Pi]])/8
In[107]:= functionPlus[# &, #^2 &, Sin[#] &]
Out[107]= Sin[#1] + #1 + #1^2 &
In[111]:= functionTimes[z, #^2 &, x, 5]
Out[111]= 5 x z #1^2 &
Now, the main test:
In[115]:=
results =
GSOrthoNormalizeGen[{1 &, # &, #^2 &, #^3 &, #^4 &}, hermiteDot,
functionPlus, functionTimes]
Out[115]= {1/\[Pi]^(1/4) &, (Sqrt[2] #1)/\[Pi]^(1/4) &, (
Sqrt[2] (-(1/2) + #1^2))/\[Pi]^(1/4) &, (2 (-((3 #1)/2) + #1^3))/(
Sqrt[3] \[Pi]^(1/4)) &, (Sqrt[2/3] (-(3/4) + #1^4 -
3 (-(1/2) + #1^2)))/\[Pi]^(1/4) &}
These are indeed the properly normalized Hermite polynomials, as is easy to verify. The normalization of built-in HermiteH is different. Our results are normalized as one would normalize the wave functions of a harmonic oscillator, say. It is trivial to obtain a list of polynomials as expressions depending on a variable, say x:
In[116]:= Through[results[x]]
Out[116]= {1/\[Pi]^(1/4),(Sqrt[2] x)/\[Pi]^(1/4),(Sqrt[2] (-(1/2)+x^2))/\[Pi]^(1/4),
(2 (-((3 x)/2)+x^3))/(Sqrt[3] \[Pi]^(1/4)),(Sqrt[2/3] (-(3/4)+x^4-3 (-(1/2)+x^2)))/\[Pi]^(1/4)}
I would suggest defining an operator other than the built-in Plus for this purpose. There are a number of operators provided by Mathematica that are reserved for user definitions in cases such as this. One such operator is CirclePlus which has no pre-defined meaning but which has a nice compact representation (at least, it is compact in a notebook -- not so compact on a StackOverflow web page). You could define CirclePlus to perform function addition thus:
(x_ \[CirclePlus] y_)[args___] := x[args] + y[args]
With this definition in place, you can now perform function addition:
h = f \[CirclePlus] g;
h[x]
(* Out[3]= f[x]+g[x] *)
If one likes to live on the edge, the same technique can be used with the built-in Plus operator provided it is unprotected first:
Unprotect[Plus];
(x_ + y_)[args___] := x[args] + y[args]
Protect[Plus];
h = f + g;
h[x]
(* Out[7]= f[x]+g[x] *)
I would generally advise against altering the behaviour of built-in functions -- especially one as fundamental as Plus. The reason is that there is no guarantee that user-added definitions to Plus will be respected by other built-in or kernel functions. In some circumstances calls to Plus are optimized, and those optimizations might be not take the user definitions into account. However, this consideration may not affect any particular application so the option is still a valid, if risky, design choice.

Replace expressions with their names in Mathematica

I have some expressions in Mathematica that are defined in terms of other expressions. I want to take some functions of the larger expression and then get the result in terms of the subexpressions. Example:
In[78]:= e1 = x + y;
e2 = 2^e1;
In[80]:= D[e2, x]
Out[80]= 2^(x + y) Log[2]
I want the output to instead be 2^e1 Log[2]. I am currently using ReplaceAll as follows, but this is cumbersome in my actual application with about 20 subexpressions.
In[81]:= D[e2, x] /. e1 -> E1
Out[81]= 2^E1 Log[2]
Difficult to obtain and keep that form, if you set e1 to be x+y. So if you do not really need that, could instead work with replacement rules.
rul = {e1->x+y, e2->2^e1};
revrul = {x+y->e1};
InputForm[D[e2//.rul, x] /. revrul]
Out[5]//InputForm= 2^e1*Log[2]
Daniel Lichtblau
Wolfram Research
Your answer appears to be specific due to the simple form of your e1 and e2. One possibility is to define e2 as a function in terms of e1, without specifying what e1 is:
In[8]:= Clear[e1, e2];
e2[x_] := 2^e1[x]
Then
In[10]:= D[e2[x], x]
Out[10]= 2^e1[x] Log[2] Derivative[1][e1][x]
which is a generally correct answer. As soon as you want it to compute, you can provide specific definition for e1. You can also do this inside Block, so that you don't introduce global definitions:
In[11]:=
Block[{e1},
e1[x_] := x + y;
D[e2[x], x]]
Out[11]= 2^(x + y) Log[2]
I suppose this approach can scale to a larger number of sub-expressions.
HTH

Solving vector equations in Mathematica

I'm trying to figure out how to use Mathematica to solve systems of equations where some of the variables and coefficients are vectors. A simple example would be something like
where I know A, V, and the magnitude of P, and I have to solve for t and the direction of P. (Basically, given two rays A and B, where I know everything about A but only the origin and magnitude of B, figure out what the direction of B must be such that it intersects A.)
Now, I know how to solve this sort of thing by hand, but that's slow and error-prone, so I was hoping I could use Mathematica to speed things along and error-check me. However, I can't see how to get Mathematica to symbolically solve equations involving vectors like this.
I've looked in the VectorAnalysis package, without finding anything there that seems relevant; meanwhile the Linear Algebra package only seems to have a solver for linear systems (which this isn't, since I don't know t or P, just |P|).
I tried doing the simpleminded thing: expanding the vectors into their components (pretend they're 3D) and solving them as if I were trying to equate two parametric functions,
Solve[
{ Function[t, {Bx + Vx*t, By + Vy*t, Bz + Vz*t}][t] ==
Function[t, {Px*t, Py*t, Pz*t}][t],
Px^2 + Py^2 + Pz^2 == Q^2 } ,
{ t, Px, Py, Pz }
]
but the "solution" that spits out is a huge mess of coefficients and congestion. It also forces me to expand out each of the dimensions I feed it.
What I want is a nice symbolic solution in terms of dot products, cross products, and norms:
But I can't see how to tell Solve that some of the coefficients are vectors instead of scalars.
Is this possible? Can Mathematica give me symbolic solutions on vectors? Or should I just stick with No.2 Pencil technology?
(Just to be clear, I'm not interested in the solution to the particular equation at top -- I'm asking if I can use Mathematica to solve computational geometry problems like that generally without my having to express everything as an explicit matrix of {Ax, Ay, Az}, etc.)
With Mathematica 7.0.1.0
Clear[A, V, P];
A = {1, 2, 3};
V = {4, 5, 6};
P = {P1, P2, P3};
Solve[A + V t == P, P]
outputs:
{{P1 -> 1 + 4 t, P2 -> 2 + 5 t, P3 -> 3 (1 + 2 t)}}
Typing out P = {P1, P2, P3} can be annoying if the array or matrix is large.
Clear[A, V, PP, P];
A = {1, 2, 3};
V = {4, 5, 6};
PP = Array[P, 3];
Solve[A + V t == PP, PP]
outputs:
{{P[1] -> 1 + 4 t, P[2] -> 2 + 5 t, P[3] -> 3 (1 + 2 t)}}
Matrix vector inner product:
Clear[A, xx, bb];
A = {{1, 5}, {6, 7}};
xx = Array[x, 2];
bb = Array[b, 2];
Solve[A.xx == bb, xx]
outputs:
{{x[1] -> 1/23 (-7 b[1] + 5 b[2]), x[2] -> 1/23 (6 b[1] - b[2])}}
Matrix multiplication:
Clear[A, BB, d];
A = {{1, 5}, {6, 7}};
BB = Array[B, {2, 2}];
d = {{6, 7}, {8, 9}};
Solve[A.BB == d]
outputs:
{{B[1, 1] -> -(2/23), B[2, 1] -> 28/23, B[1, 2] -> -(4/23), B[2, 2] -> 33/23}}
The dot product has an infix notation built in just use a period for the dot.
I do not think the cross product does however. This is how you use the Notation package to make one. "X" will become our infix form of Cross. I suggest coping the example from the Notation, Symbolize and InfixNotation tutorial. Also use the Notation Palette which helps abstract away some of the Box syntax.
Clear[X]
Needs["Notation`"]
Notation[x_ X y_\[DoubleLongLeftRightArrow]Cross[x_, y_]]
Notation[NotationTemplateTag[
RowBox[{x_, , X, , y_, }]] \[DoubleLongLeftRightArrow]
NotationTemplateTag[RowBox[{ ,
RowBox[{Cross, [,
RowBox[{x_, ,, y_}], ]}]}]]]
{a, b, c} X {x, y, z}
outputs:
{-c y + b z, c x - a z, -b x + a y}
The above looks horrible but when using the Notation Palette it looks like:
Clear[X]
Needs["Notation`"]
Notation[x_ X y_\[DoubleLongLeftRightArrow]Cross[x_, y_]]
{a, b, c} X {x, y, z}
I have run into some quirks using the notation package in the past versions of mathematica so be careful.
I don't have a general solution for you by any means (MathForum may be the better way to go), but there are some tips that I can offer you. The first is to do the expansion of your vectors into components in a more systematic way. For instance, I would solve the equation you wrote as follows.
rawSol = With[{coords = {x, y, z}},
Solve[
Flatten[
{A[#] + V[#] t == P[#] t & /# coords,
Total[P[#]^2 & /# coords] == P^2}],
Flatten[{t, P /# coords}]]];
Then you can work with the rawSol variable more easily. Next, because you are referring the vector components in a uniform way (always matching the Mathematica pattern v_[x|y|z]), you can define rules that will aid in simplifying them. I played around a bit before coming up with the following rules:
vectorRules =
{forms___ + vec_[x]^2 + vec_[y]^2 + vec_[z]^2 :> forms + vec^2,
forms___ + c_. v1_[x]*v2_[x] + c_. v1_[y]*v2_[y] + c_. v1_[z]*v2_[z] :>
forms + c v1\[CenterDot]v2};
These rules will simplify the relationships for vector norms and dot products (cross-products are left as a likely painful exercise for the reader). EDIT: rcollyer pointed out that you can make c optional in the rule for dot products, so you only need two rules for norms and dot products.
With these rules, I was immediately able to simplify the solution for t into a form very close to yours:
In[3] := t /. rawSol //. vectorRules // Simplify // InputForm
Out[3] = {(A \[CenterDot] V - Sqrt[A^2*(P^2 - V^2) +
(A \[CenterDot] V)^2])/(P^2 - V^2),
(A \[CenterDot] V + Sqrt[A^2*(P^2 - V^2) +
(A \[CenterDot] V)^2])/(P^2 - V^2)}
Like I said, it's not a complete way of solving these kinds of problems by any means, but if you're careful about casting the problem into terms that are easy to work with from a pattern-matching and rule-replacement standpoint, you can go pretty far.
I've taken a somewhat different approach to this issue. I've made some definitions that return this output:
Patterns that are known to be vector quantities may be specified using vec[_], patterns that have an OverVector[] or OverHat[] wrapper (symbols with a vector or hat over them) are assumed to be vectors by default.
The definitions are experimental and should be treated as such, but they seem to work well. I expect to add to this over time.
Here are the definitions. The need to be pasted into a Mathematica Notebook cell and converted to StandardForm to see them properly.
Unprotect[vExpand,vExpand$,Cross,Plus,Times,CenterDot];
(* vec[pat] determines if pat is a vector quantity.
vec[pat] can be used to define patterns that should be treated as vectors.
Default: Patterns are assumed to be scalar unless otherwise defined *)
vec[_]:=False;
(* Symbols with a vector hat, or vector operations on vectors are assumed to be vectors *)
vec[OverVector[_]]:=True;
vec[OverHat[_]]:=True;
vec[u_?vec+v_?vec]:=True;
vec[u_?vec-v_?vec]:=True;
vec[u_?vec\[Cross]v_?vec]:=True;
vec[u_?VectorQ]:=True;
(* Placeholder for matrix types *)
mat[a_]:=False;
(* Anything not defined as a vector or matrix is a scalar *)
scal[x_]:=!(vec[x]\[Or]mat[x]);
scal[x_?scal+y_?scal]:=True;scal[x_?scal y_?scal]:=True;
(* Scalars times vectors are vectors *)
vec[a_?scal u_?vec]:=True;
mat[a_?scal m_?mat]:=True;
vExpand$[u_?vec\[Cross](v_?vec+w_?vec)]:=vExpand$[u\[Cross]v]+vExpand$[u\[Cross]w];
vExpand$[(u_?vec+v_?vec)\[Cross]w_?vec]:=vExpand$[u\[Cross]w]+vExpand$[v\[Cross]w];
vExpand$[u_?vec\[CenterDot](v_?vec+w_?vec)]:=vExpand$[u\[CenterDot]v]+vExpand$[u\[CenterDot]w];
vExpand$[(u_?vec+v_?vec)\[CenterDot]w_?vec]:=vExpand$[u\[CenterDot]w]+vExpand$[v\[CenterDot]w];
vExpand$[s_?scal (u_?vec\[Cross]v_?vec)]:=Expand[s] vExpand$[u\[Cross]v];
vExpand$[s_?scal (u_?vec\[CenterDot]v_?vec)]:=Expand[s] vExpand$[u\[CenterDot]v];
vExpand$[Plus[x__]]:=vExpand$/#Plus[x];
vExpand$[s_?scal,Plus[x__]]:=Expand[s](vExpand$/#Plus[x]);
vExpand$[Times[x__]]:=vExpand$/#Times[x];
vExpand[e_]:=e//.e:>Expand[vExpand$[e]]
(* Some simplification rules *)
(u_?vec\[Cross]u_?vec):=\!\(\*OverscriptBox["0", "\[RightVector]"]\);
(u_?vec+\!\(\*OverscriptBox["0", "\[RightVector]"]\)):=u;
0v_?vec:=\!\(\*OverscriptBox["0", "\[RightVector]"]\);
\!\(\*OverscriptBox["0", "\[RightVector]"]\)\[CenterDot]v_?vec:=0;
v_?vec\[CenterDot]\!\(\*OverscriptBox["0", "\[RightVector]"]\):=0;
(a_?scal u_?vec)\[Cross]v_?vec :=a u\[Cross]v;u_?vec\[Cross](a_?scal v_?vec ):=a u\[Cross]v;
(a_?scal u_?vec)\[CenterDot]v_?vec :=a u\[CenterDot]v;
u_?vec\[CenterDot](a_?scal v_?vec) :=a u\[CenterDot]v;
(* Stealing behavior from Dot *)
Attributes[CenterDot]=Attributes[Dot];
Protect[vExpand,vExpand$,Cross,Plus,Times,CenterDot];

Resources