Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: clarification. Re: one liner for a function?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg46029] Re: clarification. Re: one liner for a function?
  • From: "Peltio" <peltio at twilight.zone>
  • Date: Tue, 3 Feb 2004 03:21:01 -0500 (EST)
  • References: <bvg11r$qn6$1@smc.vnet.net> <bvl8r0$t4j$1@smc.vnet.net>
  • Reply-to: "Peltio" <peltioNOSP at Miname.com.invalid>
  • Sender: owner-wri-mathgroup at wolfram.com

>You might also want to modify
>the line
>    newli = li /. (_ -> v_) -> fun[v];
>to make it look like something like
>    newli = li /. (a_ -> v_) -> Set[buildname[a],fun[v]];

It is possible to generalize the procedure ToValues in such a way that you
can get what you want in this way:

    sol= NDSolve[{
        a'[t]==-0.1a[t] x[t], b'[t]==-0.05b[t] y[t],
        x'[t]==-0.1a[t] x[t]+0.05b[t] y[t], y'[t]==0.1a[t] x[t]-0.05b[t]
y[t],
        a[0]==1, b[0]==1, x[0]==1, y[0]==0},
        {a,b,x,y},{t,0,250}];

(note that we are assigning the 'raw' list of solutions to ToValues).
This will plot the graph of the solution, labeling it with the variable's
name.

    makePlots[name_][f_] := Plot[f[t], {t, 0, 250},
        DisplayFunction ->Identity,PlotRange -> All, Frame -> True,
        FrameLabel -> {"t",ToString[name]}];

We can map this function on the list of rules given by NDSolve. Using
ToValues it is possible no to care about the nesting

    Show[GraphicsArray[
        Partition[ToValues[sols, makePlots, IndexedFunction -> True], 2]
    ]]


And if you still want to assign the plots to variables with names linked to
the name of the function you can use the following functions:
    plotName[nm_] := ToExpression[StringJoin["p", ToString[nm]]]
    setPlots[nm_][f_] := Evaluate[plotName[nm]] = Plot[f[t], {t, 0,250},
        DisplayFunction -> Identity, PlotRange -> All, Frame -> True];
We can use ToValues to extract the solutions from the list given by NDSolve
and apply to them the setPlots function, in order to have plots assinged to
separate variables. Do not evaluate this command twice unless you have
cleared the variables used.
    Show[GraphicsArray[
        Partition[ToValues[sols, setPlots, IndexedFunction -> True], 2]
    ]]
The individual plots are now assigned, as you initially asked, to the
variables whose names are in the form 'p+name of  the function'. Remember
that you'd have to force their visualization by setting the proper option in
Show.
    Show[py, DisplayFunction -> $DisplayFunction]

cheers,
Peltio
and you need the following generalized version of ToValues to do the above
(a properly placed subtitution with pure functions will do as well, but... I
have this hammer now and everything resembles a nail : ) ):

(* ToValues code follows ==================== *)

ToValues::usage = "ToValues[li] suppresses the Rule wrapper in every part of
the list li.\n ToValues[li,F] applies the function F to every rhs of Rule,
turning var->value into F[value]. If the function F has a parametrized head,
then it is possible to pass to it the lhs of Rule by setting the option
IndexedFunction->True. It will turn var->value into F[var][value].\n
When the option Flattening is set to Automatic, ToValues flattens li in
order to simplify its structure (the flattening is tuned to get the
simplest list of values for the solution of a system of several equation
in several variables). With Flattening set to None the original structure
is left intact.";

Options[ToValues] = {Flattening -> Automatic, IndexedFunction -> False};

ToValues[li_, opts___Rule] := Module[
    {newli, vars, sols, fl},
    fl = Flattening /. {opts} /. Options[ToValues];
    sols = First[Dimensions[li]]; vars = Last[Dimensions[li]];
    newli = li /. (_ -> v_) -> v;
    If[fl == Automatic && vars == 1, newli = Flatten[newli]];
    If[fl == Automatic && sols == 1, First[newli], newli]
]

ToValues[li_, fun_, opts___Rule] := Module[
    {newli, vars, sols, foo, mi},
    mi = IndexedFunction /. {opts} /. Options[ToValues];
    fl = Flattening /. {opts} /. Options[ToValues];
    If[mi == True,
        newli = li /. (x_ -> v_) -> foo[x][v],
        newli = li /. (_ -> v_) -> foo[v]
    ];
    sols = First[Dimensions[li]]; vars = Last[Dimensions[li]];
    If[fl == Automatic && vars == 1, newli = Flatten[newli]];
    If[fl == Automatic && sols == 1, First[newli], newli] //. foo -> fun
]

(* end of code ============================ *)
An example of application:

cmplxToVec[z_]:={Line[{#,{0,0}}],PointSize[.018],Point[#]}&/@{{Re[z],Im[z]}}

    vecs=ToValues[Solve[x^9==1,x], cmplxToVec ];
    Show[Graphics[vecs], AspectRatio->1,Frame->True,Axes->True];


  • Prev by Date: RE: Defining a function in module problem?
  • Next by Date: RE: Baffled By Underscore Pattern Matching
  • Previous by thread: Re: clarification. Re: one liner for a function?
  • Next by thread: Re: clarification. Re: one liner for a function?