Butaságom története

Hyperlink["Leveleim innen","http://groups.google.hu/group/comp.soft-sys.math.mathematica/"]

1. Matematikai programcsomagok

Benchmark

I understand that I can compare machines using Benchmark, but can I find the problems themselves? This should be known than anybody could compare also programs.

On my Windows XP system, for Mathematica 6, the plain ASCII text file called  Benchmarking.m  located in the directory

"C:\Program Files\WolframResearch\Mathematica\6.0\AddOns\Packages\Benchmarking"

contains the code for the problems under the section header "Benchmark Tests" (roughly the last third of the file).

Look for the function called BenchmarkTests for Mathematica 5.2, the plain ASCII text file called Benchmark.m located in the directory

"C:\Program Files\WolframResearch\Mathematica\5.2\AddOns\StandardPackages\Utilities"

contains the code for the problems under the section header "Benchmark Tests".
Regards, --Jean - Marc

Nálunk (octopus)

"C:\Program Files\main\Mathematica\6.0\AddOns\Packages\Benchmarking"

tartalmazza a Benchmarking.m állományt, ennek az utolsó harmadában vannak leírva a feladatok.

2.1. A legfontosabb tudnivalók

Elemi szintaxis: Log

Hi, I had a question about something I found in Mathematica 5.2 ... I was plotting Log[x - 1] - 2 with x = {0, 10} and y = {-10, 5} and strangely found that the graph crossed the x - axes at approximately x == 8 ...

Plot[Log[x-1]-2,{x,0,10}]

It should be 101 of course, but it seemed like 8. Then I did an NSolve with the equation set to 0, and low and behold got an answer x == 8.38906. Is this a bug in Mathematica or am I missing something here?

behold me = nézzenek csak!

ClearAll[x];
TableForm[{AbsoluteTiming[NSolve[Log[x-1]-2==0,x]],AbsoluteTiming[FindRoot[Log[x-1]-2==0,{x,8}]]},TableHeadings->{{"NSolve","FindRoot"},None}]

Log[x] is the natural logarithm of x.The base is e (or E in Mathematica' s notation). Indeed

E^2+1.

Log' s default base is Napierian -- e-- not decimal.

You are indeed missing something. Log[x] is the natural log of x (base e, not base 10). You might want to look up Log in the Help browser.

In Mathematica Log[x] is the natural logarithm of x not the logarithm base 10. That would be written Log[10, x]. So,

NSolve[Log[10,x-1]==2,x]

will give you 101. as you are expecting

2.3.1. Alapvető adatszerkezetek

Finding position in an ordered list

I wonder if it is possible to use the knowledge that a list in which I am looking for the position of an element is ordered. I want a quicker solution than e.g.

lis={ac,dmk,rfg,sty,zxxer}
Position[lis,sty]

I am certainly interested in longer lists ...

Thank you, Janos

Első megoldás

Hi Janos, I think DiscreteMath`Combinatorica`BinarySearch is what you are searching for.

Most egy kicsit másképp van.

<<Combinatorica`

?BinarySearch

sincerely, Daniel

The immediate answer is to perform a binary search.This will result with a complexity of O (Log[2, n]) (n being the length of the list) and not O (n).There is an implementation of a binary search algorithm in the Combinatorica package.
good luck
yehuda

BinarySearch szimbólumokra 1.

Janos, Apparently the Combinatorica package BinarySearch function only accepts numeric keys. We can modify this function to work with any key as follows :

binarysearch[d_,k_,ordf_:Less]:=Module[{lo=1,mid,hi=Length[d],c},
While[lo≤hi,If[(c=d[[mid=Quotient[lo+hi,2]]])===k,Return[mid]];
If[ordf[k,c],hi=mid-1,lo=mid+1]];
Return[lo-1/2]]

Then, for your example, we would use the ordering function OrderedQ[{##}]&:

binarysearch[{a,b,c},b,OrderedQ[{##}]&]

Carl Woll

BinarySearch szimbólumokra 2.

BinarySearch in the Combinatorica package is written so that it accepts only numeric input. It is very easy to change this:

BS[list_,elem_]:=Module[{n0=1,n1=Length[list],m},
While[n0≠n1,m=Floor[(n0+n1)/2];
If[list[[m]]==elem,Return[m]];
If[OrderedQ[{list[[m]],elem}],n0=m+1,n1=m-1]];
0]

BS[{a,b,c,},b]

BS[{a,b,c,},e]

0 means "not found".
Andrzej Kozlowski
Chiba, Japan

Interpoláció!

Janos, If your data is numerical, and you want to find the positions of many numbers at once, then Interpolation is a much quicker method. Again, some numeric data:

x=Sort[Table[Random[],{10^6}]];

Load your package :

Needs["Combinatorica`"]

Define my function to find the position:

f=Interpolation[Transpose[{x,N[Range[Length[x]]]}],InterpolationOrder->1];//Timing

Compare finding the positions of 5000 elements using BinarySearch and using my Interpolation method :

r1=BinarySearch[x,#]&/@Take[x,5000];//Timing
r2=Round[f[#]]&/@Take[x,5000];//Timing
r1===r2

Ezek az idők sokkal rövidebbek, mint az övéi, de f-et ötször annyi idő alatt sikerült létrehozni, mint neki.

As you can see, the Interpolation method is 40 times faster.
 Carl Woll

Az igazi megoldás: Dispatch

Hi Janos,
Here is a little experiment. First I create a list of strings.

$Version
5.1 for Microsoft Windows (January 27,2005)

Needs["Miscellaneous`Dictionary`"]

words=FindWords[__];
Length[words]

92836

Now I search the position of four words with Position :

Timing[{Position[words,"egg"],Position[words,"book
      "],Position[words,"you"],Position[words,"paper"]}]
{0.05 Second,{{{25730}},{{8885}},{{92516}},{{57800}}}}

Now I create a little database:

db=Dispatch[Thread[words->Range[Length[words]]]];
Timing[{"egg","book","you","paper"}/.db]
{0. Second,{25730,8885,92516,57800}}

It is faster, as wanted. Janos, maybe you could now determine the search time as a function of the list size.
Cheers, Vittorio

Most másképp van.

DictionaryLookup["m"~~___~~"th"]

words=DictionaryLookup[__];Length[words]

Timing[{Position[words,"egg"],Position[words,"book
      "],Position[words,"you"],Position[words,"paper"]}]

AbsoluteTiming[{Position[words,"egg"],Position[words,"book
      "],Position[words,"you"],Position[words,"paper"]}]

Dear All, 
0. Now I disclose that I am looking for a word in a dictionary.
1. Thank for the BinarySearch idea. It is much faster than Position.
2. The idea of interpolation in the case of numbers is fantastic.
3. However, I tried BinarySearch[{a, b, c}, b] without being evaluated. Thus, I need further help.
Thanks for all of you.
Janos

[snip] (=nyissz)

2.4.1. Be- és kimenet

Állományokkal való kapcsolat

Onnan szeretném beolvasni az adatokat, ahol dolgozom, nem így.

ruttkai=Import["D:\\Documents and Settings\\jtoth\\Dokumentumok\\_Mma\\butasagom tortenete1.jpg"]

SetDirectory[NotebookDirectory[]]

eva=Import["butasagom tortenete1.jpg"]

Meghibásodott állomány (Varga Nóritól) - nincs jó válasz

Hibaüzenet: 
There appears to be an error in the file named below. You should close it without saving, then check the "Load entire notebook into memory" checkbox in the Notebook Options dialog.File name : "d:\Documents and Settings\jtoth\Dokumentumok\_Tanszek\VargaN\GyogyOkt\feladat17.nb".

Using version 6.02 under Mac OS 10.5 .3 when I select File-> Open, the resulting open dialog has a button near the bottom left of the dialog labeled Options. Clicking this button results in a second dialog showing a check box that matches the error message above.

2.4.2. A program környezete

MaxFormatDepthExceeded (Szőllősi Feritől)

Any info about this? What is the built in value? Is its name $MaxFormatDepth? How to increase it?

Why not give us a bit of code that generates this problem. Often when you get a message that some Mathematica limit has been exceeded, the code has gone into some sort of infinite loop, so increasing the relevant limit is not the answer. BTW, the following command will give you all the symbols that contain the word' format' : ?*Format*
David Bailey

David, I am not really a newcomer :)
1. Try to enter ?*Format*, and wish you saw $MaxFormatDepth.
2. You may get it, if you type enough brackets, like this : If[If[... 
Please don't tell me that I should solve the problem otherwise ... 
Thank you, Janos

?*Format*

2.4.3. Kapcsolat más nyelvekkel és programokkal

LaTeX

360
Is there away to export a Mathematica output expression as a series of Latex expressions?

Two Pi, 
LaTeX is a superset of TeX macros. You will find relevant information under the keyword TeX. The following documents should help :

Hyperlink["[1] The Mathematica Book Online/A Practical Introduction to Mathematica/Files and External Operations/1.11.6 Generating and
Importing TeX","http://documents.wolfram.com/mathematica/book/section-1.11.6"]

Hyperlink["[2]Built-in Functions/Input and Output/Format Types/TeXForm","http://documents.wolfram.com/mathematica/functions/TeXForm"]

Hyperlink["[3]Front End/Menu Commands/File Menu/Save As Special... /TeX",
"http://documents.wolfram.com/mathematica/FrontEnd/MenuCommands/FileMe..."]

Hyperlink["[4]Built-in Functions/Graphics and Sound/Import and Export/Export","http://documents.wolfram.com/mathematica/functions/Export/"]

Regards, Jean - Marc

No, persze, így szebb:

TableForm[Hyperlink@@@{{"[1] The Mathematica Book Online/A Practical Introduction to Mathematica/Files and External Operations/1.11.6 Generating and
Importing TeX","http://documents.wolfram.com/mathematica/book/section-1.11.6"},{"[2]Built-in Functions/Input and Output/Format Types/TeXForm","http://documents.wolfram.com/mathematica/functions/TeXForm"},{"[3]Front End/Menu Commands/File Menu/Save As Special... /TeX",
"http://documents.wolfram.com/mathematica/FrontEnd/MenuCommands/FileMe..."},{"[4]Built-in Functions/Graphics and Sound/Import and Export/Export","http://documents.wolfram.com/mathematica/functions/Export/"}}]

hiszen

Apply[ff,{{aa,vv},{aa2,vv2},{aa3,vv3},{a4a,v4v}},1]

Vagy rövidebben:

ff@@@{{aa,vv},{aa2,vv2},{aa3,vv3},{a4a,v4v}}

TeXForm[expr] — is this what you need?

Hi,

MapThread[Export[#1,#2,"TeX"]&,{yourFilenameList,yourExpressionList}]

Tisztelt Tóth János!
 
Mathematica használata közben találtam rá arra a hasznos funkcióra, hogy a képleteket latex vagy mathml formátumban is kimásolhatjuk. Sajnos ezzel problémáim adódtak, de mivel nincs megvásárolt példányom, így technikai supportot sem kapok, pedig a hiba a programban van.
 
Arra szeretném kérni Önt, hogy segítsen megoldani a problémát, a hiba okát segít megkeresni, vagy javasol alternatívát a hiba kiküszöbölésére (esetleg az is jó volna, ha küld a wolframnak egy mailt a licensz kódjával). Természetesen tudom, hogy sokat kérek, remélem nem veszi rossz néven.
 
A hibát elő lehet idézni a mellékelt dokumentumból is. Ha olyan szélesre állítja a megjelenő ablakot, hogy az out két sorban férjen csak el (hosszú törtvonallal), és megpróbálja kimásolni az egyenletet latexben vagy mathml-ben, akkor a vágólapra csak egy failed üzenet kerül. A problémát neten még nem jelezte senki (vagy csak nem találtam rá).
 
Ha problémámban közvetlenül nem tud segíteni, kérem adjon tanácsot, kihez fordulhatok panaszommal!
 
    Üdv:
            TD

Ékezetes betűk pdf-ben, az új szabványban :)

Saving notebooks in PDF form I get an unreadable result if the text is, say, in Hungarian, probably the same problem arises with other languages with diacritical signs.

Will that happen if you change your encoding from let say western iso to Unicode UTF (8) or something similar? János

------"..because Annushka has already bought sunflower oil, and not only bought it, but spilled it too." 
Bulgakov: Master and Margarita

(to spill=kiloccsant, kilöttyent)

Just the same happens if the text is in Russian. There is no way for exporting such text to PDF except printing notebook to PDF-printer.

Yes, I can confirm the problem. An important thing that you did not mention in your post is that the problem does not occur with characters that are representable in latin1 encoding. So in Hungarian the two problematic characters are = FB and = F5 (ű and ő for those whose newreader does not like UTF8). Here' s a test case :

ImportString[ExportString["őű","PDF"],"PDF"]

Hyperlink["Szabolcs levele","http://groups.google.hu/group/comp.soft-sys.math.mathematica/search?group=comp.soft-sys.math.mathematica&q=pdf+and+accents&qt_g=Keres%C3%A9s+e+csoporton+bel%C3%BCl"]

I am on a Mac, so I go to System Preferences→ International→ Input Menu, and I check in U.S.Extended. For that keyboard the script is Unicode. Then I check a little checkbox that says: "Show input menu in menu bar". Then on my menubar on the top of the screen I can select U.S.Extended. I see that there is no Unicode script for Hungarian, and not even for Sweedish on the Mac - I am still using 10.4 .11 -, but there is for Finnish and many other accented languages. János
U.I. 
I do not know PC

>...you change your encoding from let say western iso to Unicode UTF (8) or something similar?
How we can do this?The following code:

a = ToString["<text in Russian>", CharacterEncoding -> "Unicode"]
Export["C:\\1.pdf", a]

where < text in Russian > is in really text in Russian (cyrillic alphabet) generates just the same unreadable file.

I have found some workaround but it is not fine:

b=ImportString[ExportString["<text in Russian>","PDF"],"PDF"][[1]]
Export["C:\1.pdf",b]
Import["C:\1.pdf"][[1]]

All symbols will present as contours in the output file.

These are known limitations in Mathematica' s PDF export capabilities.
Rob
Wolfram Research

Thanks to everybody for the contribution. Now I had a lesson with my smart students and they told me that I have to choose'' PDF printer'' from the File | Print | Printers menu, and then my.nb will be printed into a nice PDF file.

2.5. További információforrások

Másolás a dokumentációból

The only result of ArcCosh[1]  _sometimes _ is a repetition of the input ArcCosh replaced by a button. I could not reproduce this with other trigonometric functions.
Anybody have seen something like this?

Thank you.
 Janos

Button[ArcCosh,Inherited,Rule[BaseStyle,"Link"],Rule[ButtonData,"paclet:ref/ArcCosh"]][1]

Hi,

This probably happened because you copied the function from the
Documentation Center, where the function had an underlying button.If you copy/paste such a function you should use (with the function selected) one of these : menu item :

Edit/Copy As/Plain Text

right mouse button :

Copy As/Plain Text

És ez a háttér miért van?

Best Regards
Norbert Marxer

3.1.2. Halmazok

Függvény értékkészlete - intervallumaritmetika

If you ask Mathematica what is the range of Sin restricted to e.g. [0,(π/6)] you will get a correct answer.

Sin[Interval[{0,(π/6)}]]

This is not always the case, however. Let

ff[x_]:=5Exp[-2x]-3Exp[-x]

Then the answer

ff[Interval[{-Infinity,+Infinity}]]

is different from what you see on the figure

Plot[ff[x],{x,-1,6}]

of the function.

Is there a bug here?

Not a bug

This is not a bug but just the way "Interval arithmetic" works. Applying a function to an interval does not give you the range of the function: it gives you an interval which will contain the range of the function. The purpose of interval arithmetic is error estimation, and it tends to "over estimate". This is, indeed, its weakest point, but that is how it works. If you ever get an answer that does not contain the range of the function then you will certainly have found a bug. There are other methods of error estimation that do not suffer from this problem to such an extent (so called "affine arithmetic" is one) but they all overestimate (the principle that "it is better to be safe than sorry")
To see how this overestimation comes about note that if :

g[x_]:=5(E^(-2x));h[x_]:=3(E^(-x));

then

Through[{g,h}[Interval[{-Infinity,+Infinity}]]]

{Interval[{0, =B0}],Interval[{0, =B0}]}

which indeed give the correct ranges. But to compute the image of the difference Mathematica simply computes:

Subtract@@%

which is, of course, much larger than the true range.
  Andrzej Kozlowski

És mégis

As Andrzej has already pointed out, there is no bug. It should also be mentioned that one can, easily, get the desired range in this example using f[Interval[{-Infinity, Infinity}]]. To do so, we must avoid the so - called "problem of dependence" by being careful about exactly how f is expressed. (Just think of "completing the square" in order to rewrite f.)

ClearAll[f];
f[x_]:=5(((Exp[-x]-(3/10)))^2)-(9/20)

f[Interval[{-Infinity,Infinity}]]

But be aware that it is all too easy to find functions which cannot be expressed in a way that avoids the problem of dependence.
  David W.Cantrell

3.1.4. Függvények

Showing defined functions - Információszerzés

I have defined a series of functions in Mathematica. I was wondering, is there anyway to get Mathematica to display all current defined functions that are being stored in memory (something similar to the 'who' command in another system.

János

Names["Global`*"]

this may help you.

Jó tanácsok sorozata

By default user defined symbols are store in the Global context. You can list all definitions with either

?Global`*

Information["Global`*",LongForm->False]

Information["Global`*"]

Some other functions exist. See

Hyperlink["Information","http://documents.wolfram.com/mathematica/functions/Information"]

obsolete=elavult

Hyperlink["Information","http://reference.wolfram.com/mathematica/ref/Information.html"]

Hi,

Information["Global`*"]

or

Definition/@Names["Global`*"]

Vigyázat, hosszú!A lista a záró zárójelig tart.

A szép megoldás

ClearAll[functionQ];
SetAttributes[functionQ,{Listable}];
functionQ[x_String]:=functionQ[ToExpression[x]];
functionQ[x_Symbol]:=Length[Flatten[#[x]&/@{DownValues,UpValues}]]>0;
functionQ[x_]=False;

y=7;

f1[x_]:=x;
SetAttributes[f1,Listable];
f2[x_]=2x;
f3/:Mean[f3[x_]]:=a;

Names["Global`*"]

Select[Names["Global`*"],functionQ[#]&]

Validating functions input

I have a function f that must have its input validated.  I want to validate if x≤(2^y). If it' s valid, then just return the symbol f[x,y] unevaluated. If it' s not valid, I want to return some
symbol, Null for instance, and issue an error message. The following is a try, but it doesn' t work, because it' s definition is recursive:

f::invalid="Invalid arguments";
f[x_,y_]:=If[x≤2^y,f[x,y],Message[f::invalid]]

Is there any way to implement this?

Condition nem rossz ötlet

Look up Condition in the help file

Message 1.

ClearAll[f,x,y];
f::invalid="Invalid arguments";
f[x_,y_]:=(Message[f::invalid];Null)/;x>2^y;
f[2,2]

f[5,2]

f[x,y]

Bob Hanlon

Message 1.

Nilton, 
Strange. The usual procedure is to leave it unevaluated if the arguments are not valid. In any case,

ClearAll[f,x,y];
f::invalid="Invalid arguments, `` > ``";
f[x_,y_]/;¬(x≤2^y):=Message[f::invalid,x,2y]

f[1,3]

f[3,1]

David Park

Miért nem jó?

Hi Nilton,
You want a function that returns unevaluated if the input fullfills some condition and does something if the condition is not fulfilled.
 Well, this calls for negation:

ClearAll[f,x,y];
!f[x_,y_]/;!x≤2^y:=(Print["invalid Input"];Null)

This will print an error message and return Null if the condition : x <= 2^y is not (! ) fulfilled.
     Sincerely, Daniel

Szimbolikus feltétel

Hi Nilton, restrict the definition to invalid cases and let f simply print the error message:

ClearAll[f,x,y];
f::invalid="Invalid arguments `1` > `2`";
f[x_,y_]/;x>2^y:=Message[f::invalid,x,2^y]

Since f doesn' t know what to do with x <= 2^y, it returns unevaluated:

f[1,1]

and prints the message otherwise:

f[3,1]

but this version can not handle (most) symbolic expressions :

Simplify[f[2^n+1,n]]

If we re - define f as

f[x_,y_]/;Simplify[x>2^y]:=Message[f::invalid,x,2^y]

then

f[1+2^n,n]

acts as desired but this might take some time when x and/or y are large expressions.--Peter Pein

Hello, 
All you need to do is pick off the case that requires an error message and leave the others :

ClearAll[f,x,y];
f[x_,y_]:=Message[f::invalid]/;x>2^y;

f[1,1]

f[3,1]

David Bailey

János

Hi, Nliton, What about this ugly solution :

ClearAll[f,x,y];
f[x_,y_]:={Null,message}/;x>2^y

f[1,1]

f[3,1]

Hold - nem tetszik

Nilton, 
If you want the result to be unaveluated, you have to say so. Use :

ClearAll[f,x,y];f[x_,y_]:=If[x≤2^y,Hold[f[x,y]],Message[f::invalid]]

f[1,1]

f[3,1]

ClearAll[f,x,y];f[x_,y_]:=If[x≤2^y,HoldForm[f[x,y]],Message[f::invalid]]

f[1,1]

f[3,1]

Greetings from Croatia, Drago

Így kell csinálni

Clear[f]
f::badinput = "`1` > \!\(`2`\^2\). The first argument needs to be less than or equal to the square of the second.";
f[x_, y_] /; x > y^2 := (Message[f::badinput, x, y]; );

f[1, 2]

f[2, 1]

3.1.5. Függvények ábrázolása

Manipulate és Plot (én akartam okos lenni...)

Hii all

with

ta=0.9;
tb=0.9;
ka=Sqrt[1-ta^2];
kb=Sqrt[1-tb^2];
ω=(2*10^15)/λ;
L=100 π;
T=2.6*10^-12;
out1=(ta-tb*(Exp[-α L/2])*Exp[I ω T])/(1-ta*tb*(Exp[-α L/2])*Exp[I ω T]);
out2=(-ka kb Exp[-α L/4] Exp[I ω T/2])/(1-ta tb Exp[-α L/2] Exp[I ω T]);
Manipulate[Plot[Evaluate[(Abs[out1])^2],{λ,1.54,1.56},PlotRange->{0,1},AxesLabel->{"λ","out1"}],{α,1,100,1}]
Manipulate[Plot[Evaluate[(Abs[out2])^2],{λ,1.54,1.56},PlotRange->{0,1},AxesLabel->{"λ","out2"}],{α,1,100,1}]

I don't see any output graph for expressions out1 and out2. Can some one tell me what mistake I have done? Mathematica version is 6.0.
Many thanks

Sooraj

Alpha received no values yet.

Hi, the graphics in version 6

give no error messages or warning if you try to draw something that can' t be drawn
(complex values, symbols without a value ...) and I would think that this is the case here. Check your expression outside Manipulate[]

Regards,
Jens

This works:

Manipulate[out1=(ta-tb*(Exp[-α L/2])*Exp[I ω T])/(1-ta*tb*(Exp[-α L/2])*Exp[I ω T]);
Plot[Abs[out1]^2,{λ,1.5,1.6},PlotRange->All,AxesLabel->{"λ","out1"}],{α,1,100,1}]

The plot is the same flat line for every alpha, however ... since out1 doesn' t change much when lambda changes:

out1//Cancel

and it doesn' t depend on alpha AT ALL. Bobby

MultipleListPlot missing

While MultipleListPlot has become obsolete in Mathematica 6.0, unfortunately the enhanced ListPlot function does not provide all the capabilities of MultipleListPlot.E.g., ploting the data sets

data1={{0,1},{1,1.4},{1.5,2},{1.9,2.3}};
data2={{0.2,1},{1.2,1.4},{1.4,2},{1.8,2.3}};

by the command

ListPlot[data1,data2]

does not work, whereas this was possible with MultipleListPlot.Is there an easy way to represent both data sets in the same plot in Mathematica 6.0? Many thanks in advance, H. Hogreve

Hi, it works when you get the syntax right.

ListPlot[{data1,data2}]

hope this helps, Daniel

Try

ListPlot[{data1,data2},PlotMarkers->{{□,8},{■,14}}]

: )
 
 I hope this helps :)

Janos

You can obtain a nicer plot if you add the Filling option :

ListPlot[{data1,data2},Filling->Axis]

Regards!
Jose

Hi, and what can you see with :

ListPlot[{data1,data2}]

??
 Regards Jens

Hallo, die Syntax hat sich leicht geändert :

ListPlot[{data1, data2}]

Peter Klamser

Hi, At the risk of replying before the first cup of coffee .... This question was answered in. All you need is

ListPlot[{data1,data2}]

And you can modify things from there. For example

ListPlot[{data1,data2},Joined->True,Mesh->All]

More options at ref/ListPlot in the documentation centre. Regards, Dave.

Right. But using proper syntax, i.e.,

ListPlot[{data1,data2}]

works fine in version 6

3.2.1. Algebrai polinomok

Tényező kiemelése

I' m trying to factor a rational constant (4/3) L in equation 1 so that it looks like equation 2
But I was unable to do so. What would be the correct transformation to do so?

eq1=(4/3)*L*A-(4/3)*L*B==a*k*t

eq2=(4/3)*L*(A-B)==a*k*t

Use the function Factor, Janos

Newbie=új fiú

Here is a newbie approach :

Factor/@eq1

János  (Másik)

Más is azt mondja, nemcsak aki János

The simplest way to do this is :

eq1=(4/3) L A-(4/3) L B==a k t;

Factor/@eq1

If you want to do this by means of pattern matching (far too much typing for my taste) then you need to use something like this :

eq1/.HoldPattern[Rational[n_,m_] (x_)(y_)+Rational[p_,m_](x_)(z_)/;n==-p]:>Rational[n,m]x(y-z)

Úthenger

Some options are :

Factor/@eq1

Collect[eq1,L]

Factor/@Collect[eq1,L]

Factor@eq1

FactorTerms[eq1]

Bobby

Összegezve

What I was looking for is the way to do a rule replacement to extract out the rational.Thanks to your help, I' m able to understand how to do it. For the record, this is what I have learned.

FullForm[eq1]

eq2=(4/3)*L*(A-B)==a*k*t;

FullForm[eq2]

eq3=eq1/.HoldPattern[Plus[Times[Rational[n_,m_],a_,b__],Times[Rational[p_,m_],a_,z__]]/;n==-p]:>Rational[n,m]*a*(b-z)

FullForm[eq3]

3.4.1. Beépített speciális függvények

Hermite-polinomokra vonatkozó összefüggések (Póta Gyuri feladata), Rodrigues-formula

Hyperlink["Rodrigues' formula","http://en.wikipedia.org/wiki/Orthogonal_polynomials#Rodrigues.27_formula"]

Hi, All,
1. I have found in the help that

(∂_z) HermiteH[n, z]==2 n HermiteH[-1+n,z]

Nice. I wanted to reproduce this myself. Then, it should also work for me :

D[HermiteH[n,z],z]

2. I would also like to have

Simplify[H[n,-x]==-H[n,x],Assumptions->n∈Integers]

but even FunctionExpand does not produce this.

FunctionExpand[H[n,-x]+H[n,x]]

3. This should be zero:

FunctionExpand[HermiteH[n + 1, x] - 2x HermiteH[n, x] + 2n HermiteH[n-1,x], n ∈ Integers ∧ n > 0 ∧ x ∈ Reals]

4. This is known to be zero:

Integrate[HermiteH[n, x] E^(-x^2), {x,-∞,∞},Assumptions ->(n ∈ Integers ∧ n > 0)]

5. This should be the KroneckerDelta[m, n]:

Integrate[HermiteH[n, x]HermiteH[m, x](E^(-(x^2))),{x,-∞,∞},Assumptions->(n∈Integers∧m∈Integers∧n>0∧m>0)]

I know, I know, mathematical program packages know everything except symbolic calculations, still ...
Can anybody help me?
  
Thanks,

János

Hi Janos,
Mathematica does not know too many features about Hermite polynomials.
 But needed features can be added. See below

sincerely, Daniel

> 2. I would also like to have H[n, -x] == -H[n, x],
This can be done by adding a rule to HermiteH. First you must unprotect HermiteH:

Unprotect[HermiteH]

then you can define:

HermiteH[n_, -x] := -HermiteH[n, x]

> 3. This should be zero.

FunctionExpand[HermiteH[n + 1,x]-2x HermiteH[n,x]+2n HermiteH[n-1,x],n∈Integers ∧ n > 0 ∧ x ∈ Reals]

This can be achieved by defining a rule for H[n + 1, x] as above:

HermiteH[n_Integer+1,x_]:= 2 x HermiteH[n,x]-2 n HermiteH[n-1,x]

> 4. This is known to be zero:

> Integrate[HermiteH[n, x] E^(-x^2, {x,-∞,∞},Assumptions ->(n ∈ Integers ∧ n > 0)]

A further rule is needed here. You would assigne this rule not to Integrate, but to HermiteH by :

HermiteH/; .....

> 2. I would also like to have H[n, -x] == -H[n, x],
> but even FunctionExpand does not produce this. 
Because this is not true unless n is an integer.

Sajnos, kevés.

> 3. This should be zero.

FunctionExpand[HermiteH[n+1,x]-2x HermiteH[n,x]+2n HermiteH[n-1,x],n∈Integers∧n>0∧x∈Reals]

Series expansion is one possible approach here:

2 n HermiteH[n-1,x]+HermiteH[n+1,x]-2 x HermiteH[n,x]+O[x]^4//FullSimplify

A better way to approach this is to use the generating function. Note that the generating function and a wide range of properties can be obtained at

Hyperlink["Hermiteről","http://functions.wolfram.com/Polynomials/HermiteH/"]

In particular, at

Hyperlink["Hermiteről még több","http://functions.wolfram.com/05.01.11.0001.01"]

one effectively has

E^(2xt-t^2)==Sum[HermiteH[n,x]t^n/n!,{n,0,Infinity}]

> 4. This is known to be zero:

Integrate[HermiteH[n,x]E^(-x^2),{x,-∞,∞},Assumptions->(n∈Integers∧n>0)]

Use the generating function. Computing the integral

Integrate[E^(2xt-t^2)Exp[-x^2],{x,-Infinity,Infinity}]

gives you the desired result.

> 5. This should be the KroneckerDelta[m, n]:

Integrate[HermiteH[n,x]HermiteH[m,x]E^(-x^2),{x,-∞,∞},Assumptions->(n∈Integers∧m∈Integers∧n>0∧m>0)]

Series expansion of the integral,

Integrate[E^(2xt-t^2)E^(2xu-u^2)Exp[-x^2],{x,-Infinity,Infinity}]

shows that the integral is not KroneckerDelta[m, n] but

Sqrt[Pi]KroneckerDelta[m,n]2^nn!

Now try the integral of a product of 3 HermiteH functions ...
> I know, I know, mathematical program packages know everything except
> symbolic calculations, still ...
Humans use the generating function (or other general techniques) to compute such expressions. Using the same technique in Mathematica yields
the same results.
Cheers, Paul
--Paul Abbott Phone : +61 8 6488 2734
School of Physics, M013 Fax : +61 8 6488 1014
The University of Western Australia (CRICOS Provider No 00126 G)
AUSTRALIA http : // physics.uwa.edu.au/~paul
http : // InternationalMathematicaSymposium.org/IMS2005/

Why doesn' t Mathematica have anything on Rodrigues' formula, which is used to calculate Legendre Polynomials for solutions of Spherical differential equations.Can Wolfram Research look into adding this to Mathematica' s capabilities? Also helpful would be to somehow figure in the relationship between Rodrigues' formula, LegendreP and Kroneckerdelta. Because doing those integrals is really a mess. Any comments on this would be welcome.

See my question and PDs answers which are useful still not absolutely convincing.1. Pratik Desai Jul 20, 12 : 39 am show options

Ki találja meg?

Szimbolikus számolás (Szabó Sanyi feladata)

sanyi=-(2/27)+((253 HypergeometricPFQ[{-(1/2),-(1/6),(1/6)},{(4/3),(5/3)},-(1/729)])/108)-((911 HypergeometricPFQ[{(1/2),(5/6),(7/6)},{(7/3),(8/3)},-(1/729)])/6298560)+((73 HypergeometricPFQ[{(3/2),(11/6),(13/6)},{(10/3),(11/3)},-(1/729)])/9795520512)==((2(-1+10 (Sqrt[10])))/27)

N[sanyi]

N[List@@sanyi]

Oleksandr Pavlyk

$Version

"6.0 for Microsoft Windows (32-bit) (March 13, 2008)"

$Version

ClearAll[expr];
expr=-(2/27)+((253 HypergeometricPFQ[{-(1/2),-(1/6),(1/6)},{(4/3),(5/3)},-(1/729)])/108)-((911 HypergeometricPFQ[{(1/2),(5/6),(7/6)},{(7/3),(8/3)},-(1/729)])/6298560)+((73 HypergeometricPFQ[{(3/2),(11/6),(13/6)},{(10/3),(11/3)},-(1/729)])/9795520512);

Now define

e1=({D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],z],D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],{z,2}],D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],{z,3}]}/.{a->0,z->(1/9)}//Expand)

Now repeat the same with variable a set to 0 from the outset:

e2=FullSimplify[With[{a=0},{D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],z],D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],{z,2}],D[HypergeometricPFQ[{-(1/2),-(1/6),(1/6)+a}-1,{(4/3),(5/3)}-1,-(z^3)],{z,3}]}/.{a->0,z->(1/9)}]]

Now solve for hypergeometric functions:

ru=Thread[Union[Cases[e1,_HypergeometricPFQ,Infinity]]->{h1,h2,h3}]

and substitute back into your original expression :

FullSimplify[expr/.(Solve[((e1-e2)/.ru)==0,{h1,h2,h3}]/.(Reverse/@ru))]

3.4.5. Integrálszámítás

(∫_0^1)(((s^s)(1-s))^(1-s))Sin[π s]ds (Szabó Sanyi feladata)

Any idea to calculate this integral (symbolically) or reformulate it using some special functions?

Are you serious?

We don' t even know how to do

Integrate[s^s,{s,0,1}]

I doubt

if there is a CAS that will get a closed form result for this integral. Did you try contour integration or Table - lookup? 
Table of Integrals, Series, and Products, Sixth Edition by I.S.Gradshteyn (Editor), I.M.Ryzhik (Editor), Alan Jeffrey
(Author), Daniel Zwillinger (Author)

and the more extended series of books of

A = 2 E P.Prudnikov, Yu.A.Brychkov, and O.I.Marichev

Dimitris

Az ellenség

Hi again!
After suggestion for another forum visit the following page:

Hyperlink["Az ellenség","http://www.mapleprimes.com/forum/fourier-coefficient"]

Új kérdésem

Yes, I realized (only now : () this as well. It is mystic how the Taylor series of the original integrand around 1/2 behaves. It is quite nice up to 7, and fills up a few screens if you are interested in the Taylor series up to say 9. Any idea of the reason? Janos

TableForm[Normal[Series[s^s(1-s)^(1-s)Sin[Pi s],{s,(1/2),#}]&/@Range[7]], TableHeadings->{Range[7],None}]

Reakció az új kérdésre

Hi Janos, I' ve seen worse expansions ...

ClearAll[f];
f[s_]=s^s*(1-s)^(1-s)*Sin[Pi*s];

Timing[Expand/@Series[f[s],{s,1/2,12}]]

Ojjaj, vmit elszúrtam :).

Regards, Peter

Plouffe's Inverter

I don' t know if Mathematica can calculate it symbolically, but if you calculate it numerically with enough precision, you can use the

Hyperlink["Plouffe's Inverter","http://pi.lacim.uqam.ca/eng/"]

to check that it is Pi*E/24 (or at least, very very close to)

NIntegrate[s^s(1-s)^(1-s)Sin[Pi s],{s,0,1},WorkingPrecision->40]

N[Pi*E/24,40]

V. Astanoff megmutatja, hogy mi se vagyunk alábbvalóak

Here is a way of computing that integral (without Plouffe' s inverter) using Stirling' s formula and Recognize:

<<NumberTheory`

stir=First[Solve[s!==ss*Exp[-s]*Sqrt[2*Pi*s]*(1+k),ss]]

fs[s_]=ss/.stir

ff=fs[1-s] fs[s] Sin[Pi*s]//FullSimplify[#,0<s<1]&

i1=Integrate[ff,{s,0,1}]

i2=NIntegrate[s^s (1-s)^(1-s)Sin[Pi*s],{s,0,1},WorkingPrecision->40];

kk=Solve[i1==i3,k]

Ez az aktuális változat, a súgó nem segít igazán. Bele kell írni a működő programot a Mathematica egy korábbi változatába, majd megnézni a 6-ossal, akkor a  Version Advisor segít.

MinimalPolynomial[RootApproximant[k/.kk[[2]]/.i3->i2,4],k]==0

Recognize[k/.kk[[2]]/.i3->i2,4,k]==0

Solve[%]

i1/.%[[2]]//Simplify

3.1.1. Logikai műveletek

Válasz nélkül

ClearAll[a,b,c,x,i];
Resolve[Exists[x,a x^2+b x+c==0&&x>0],Reals]

(taken from the Help) works fine. However,

Resolve[Exists[x,Part[{-1,0,2,-3,4,0},x]>0],Integers]

Resolve[Exists[x,Element[x,Integers],Part[{-1,0,2,-3,4,0},x]>0]]

does not work.My guess is that Part is evaluated differently from Equal, but I do not know how to fix the problem.

3.4. Analízis

3.4.4. Differenciálszámítás

Függvények szélsőértékei

NMinimize és feltételek (Várdai Judit és Garay Barnabás feladata)

We should like to minimize a matrix function with positivity constraints and receive negative answer. Here is our program (sorry, I could not simplify it further):

ClearAll[interpol,P];interpol[P_] := Module[{A, a, b, c, d, X, aa, elem, celesfelt},
    A = {{a, b}, {c, d}};
    X := Simplify[Inverse[A].P];
    dis[aa_] := Tr[( aa - IdentityMatrix[2]).Transpose[aa -IdentityMatrix[2]]];
elem = Join[{a > 0, b > 0, c > 0, d > 0},
Thread[Flatten[Simplify[X ]] > 0]];celesfelt = Join[{dis[A] + dis[X]}, elem];
    {A, X, Thread[Flatten[Simplify[X]] > 0]} /. NMinimize[celesfelt,{a, b, c,d}][[2]]]

interpol[{{1.3125461545700279`, 0.31851196579139557`}, {0.0029101631196892354`, 2.047721830824522`}}]

Is there any way to enforce NMinimize to take into consideration the constraint seriously?
Thanks,

Janos

Válasz

Legyen a minimalizálandó függvény (a^2),(b^2), stb. függvénye.

3.4.5. Integrálszámítás

Volterra integral equation

Consider the integral equation: (∫_(-4)^x)K(x,t)θ(t)dt=f(x)   (-4<x<0), where
 K (x, t) = x + t and  f (x) = 1
Two questions : 
1) does this equation fit the definition of a "Volterra integral equation of the first kind"?
2) Can Mathematica solve for θ(t)? (or can it be proven that given the above conditions θ(t) does not exist?)

Hi, Jim,

1) I do not know.
2) I do not know.
3) Let T[x] := Integrate[theta[t], {t, -4, x}], then integration by parts gives T[x] = 1/(2 x - 1), and theta is obtained as the derivative of this function.
I hope this helps, 
János

NIntegrate - Gaussian quadrature (Horváth Miklós feladata)

NIntegrate[x^4,{x,0,1},Method->GaussKronrod,GaussPoints->2](*Version 5.2*)

NIntegrate[x^4,{x,0,1},Method->{"GaussKronrodRule","Points"->2}](*Version 6.0*)

gives 0.2, the exact result, although the Gauss quadrature should be inexact on a polynomial of degree 2 n + 2 where n is the number of GaussPoints. More exactly, we expected the same results as here:

<<NumericalMath`GaussianQuadrature`
gw=GaussianQuadratureWeights[2,0,1]
f[{x_,y_}]:=x^4 y
Total[f/@gw]
0.194444

This is inexact, OK. Why is NIntegrate so good? Something I may have missed.
Thank you for your help.
  Janos

Hi

I wouldn' t be surprised if Mathematica does some preprocessing of the integrand and realizes that the integral can be faster computed in closed form; however the implementation notes
on NIntegrate do not state such a thing

Bye
Ben

Subdivision

Hi Janos, obviously a subdivision of the interval takes place:

Length[xvals=Reap[result=NIntegrate[x^4,{x,0,1},Method->GaussKronrod,GaussPoints->2,EvaluationMonitor:>Sow[x]]][[2,1]]]
result

-->155
0.2

Length[xvals=Reap[result=NIntegrate[x^4,{x,0,1},Method->{"GaussKronrodRule","Points"->2},EvaluationMonitor:>Sow[x]]][[2,1]]]
result

With

ListPlot[xvals]

you can see, where the evaluations have been done. At least a warning can be forced by additionally setting MaxRecursion to 0 :

Length[xvals=Reap[result=NIntegrate[x^4,{x,0,1},Method->{"GaussKronrodRule","Points"->2},MaxRecursion->0,EvaluationMonitor:>Sow[x]]][[2,1]]]

Abs[result-1/5]

Peter

3.5.9. Parciális differenciálegyenletek

A Laplace-operátor sajátértékei (Horváth Miklós feladata)

I wonder if any of you is aware of Mathematica code to solve the eigenvalue problem Δu=λu     u|∂ Ω=0 on arbitrary (planar) domain. (Circle, rectangle are trivial.)

Thank you.

I suggest to read pages 269 ff of Mathematical Methods in Physics and Engineering using Mathematica, Chapman and Hall, ISBN 1-58488-4029

Dear Professor Cap, Thank you for the citation.I waited a few days because I have a book with a similar title in my office, and now it turned out this is a different book, and it also turned out that you are the author of the proposed book.(Although it is with and not using :)))

Now what I can do is that I order it through our librarian, (because we do use such books in teaching Mathematica for engineers) and if anything goes well we shall receive it within half a year or even more ...
I wonder if you could send me the relevant few papers or an article which may contain the code of the problem.
Thank you.
Sincerely yours,

Szóval akkor még turkálunk a books.google.com-on...

3.5. Differenciálegyenletek

DSolve komplex megoldásának ábrázolása (most én vagyok az okos)

So I' m trying to run a simple program that will solve this series of differential equations and plot the the x[t] function in the complex plane. Here' s my code.

solution=NDSolve[{x'[t]==2p[t],x[0]==2,p'[t]==-2x[t],p[0]==Sqrt[-3]},{x,p},{t,0,2π}]

repart[t_]:=Re[x[t]/.solution]
impart[t_]:=Im[x[t]/.solution]

ParametricPlot[{repart[t],impart[t]},{t,0,2π},PlotRange->{{-2,2},{-2,2}}]

For some reason, when I go to plot the curve, I get an error saying
ParametricPlot::pptr : {repart[t], impart[t]} does not evaluate to a pair of real numbers at t = 2.617993877991494`*^-7

Delete the outer braces

solution=NDSolve[{x'[t]==2 p[t],x[0]==2,p'[t]==-2 x[t],p[0]==Sqrt[-3]},{x,p},{t,0,Pi}][[1]];
repart[t_]:=Re[x[t]/.solution]
impart[t_]:=Im[x[t]/.solution]
ParametricPlot[{repart[t],impart[t]},{t,0,Pi},PlotRange->{{-2,2},{-2,2}}]

Try

ParametricPlot[Evaluate[{repart[t],impart[t]}/.solution],{t,0,2 π}]

Hope, it helps, Janos (its me)

This can also be solved exactly

solution=DSolve[{x'[t]==2 p[t],x[0]==2,p'[t]==-2 x[t],p[0]==Sqrt[-3]},{x,p},t][[1]]

Hi,

solution=NDSolve[{x'[t]==2 p[t],x[0]==2,p'[t]==-2 x[t],p[0]==Sqrt[-3]},{x[t],p[t]},{t,0,2*Pi}];

repart[tau_]:=(Re[x[t]/.solution[[1]]])/.t->tau
impart[tau_]:=(Im[x[t]/.solution[[1]]])/.t->tau

ParametricPlot[{repart[t],impart[t]},{t,0,2 Pi},PlotRange->{{-2,2},{-2,2}}]

may help.
Regards
Jens

NDSolve és szakaszonként megadott fügvény

I would like to solve a diff eq on a very large interval, therefore I solve it on successive intervals. When putting the results together I get a _relatively _ good figure and an error message. Note that there is a hole on the graph of the function. Any other solution to join InterpolatingFunction objects would be appreciated.
Thank you, Janos

f[ini_,tlast_]:=Module[{from=tlast,to=tlast+1,X},{X=(x/.NDSolve[{x'[t]==-0.5 x[t],ini},x,{t,from,to}])[[1]],to,X[to]}]
nl=NestList[f[x[#[[2]]]==#[[3]],#[[2]]]&,{zzz,0,2.0},3];
full[t_]:=Piecewise[Transpose[{Table[nl[[k,1]][t],{k,2,4}],Table[k≤t<k+1,{k,0,2}]}]]
Plot[full[t],{t,0,3}]

Hi Janos, note that Piecewise has the attribute HoldAll. However, you want to evaluate the body of Piecewise before feeding it to Piecewise. I do this with "tt" :

f[ini_,tlast_]:=Module[{from=tlast,to=tlast+1,X},{X=(x/.NDSolve[{x'[t]==-0.5 x[t],ini},x,{t,from,to}])[[1]],to,X[to]}]
nl=NestList[f[x[#[[2]]]==#[[3]],#[[2]]]&,{zzz,0,2.0},3];
tt=Transpose[{Table[nl[[k,1]][t],{k,2,4}],Table[k≤t<k+1,{k,0,2}]}];
Plot[Piecewise[tt],{t,0,3}]

hope this helps, Daniel

Manipulate és DSolve

Manipulate[Plot[E^(k t),{t,0,1},PlotRange->{0,E}],{k,-1,1}]

works fine. However, if I solve the corresponding ODE symbolically :

ds=DSolve[{x'[t]==k x[t],x[0]==1},x[t],t][[1]];

it does not work :

Manipulate[Plot[Evaluate[x[t]/.ds],{t,0,1}],{k,-1,1}]

Hi, try

Manipulate[Dynamic@Plot[Evaluate[x[t]/.ds],{t,0,1}],{k,-1,1},LocalizeVariables->False]

Regards
Jens

Diszkrét matematika

Geometria

3.8. Lineáris algebra

3.8.3. Műveletek vektorokkal és mátrixokkal

Mátrix rangja

MatrixRank[.,Modulus->8] * Bugár? (Szőllősi Feri feladata)

Let us introduce

U={{4,1,5},{3,4,2},{7,2,4}};
V={{5,1,4},{2,4,3},{4,2,7}};

and calculate the ranks :

{MatrixRank[U,Modulus->8],MatrixRank[V,Modulus->8]}
{2,3}
Version:5.2 for Microsoft Windows

Kizárták a hibát.

{MatrixRank[U,Modulus->8],MatrixRank[V,Modulus->8]}

I do not think the rank should depend on the order of columns.Any idea?Thanks, Janos

Might be a smallish bug. I think maybe it should return unevaluated. Since we' re not working over a field I don' t know that the rank is well defined. If it is, my guess is it would depend on the dimension of the null space. That can be assessed correctly using the Hermite decomposition on the augmented matrix

U2 = Join[U, 8*IdentityMatrix[Length[U]]]

A correct interpretation of the result would indicate there are no null vectors, hence rank would be 3. But again, offhand I' m not sure this is really a correct definition.
Daniel Lichtblau
Wolfram Research

Mátrix minorai

3.9. Számelmélet

3.9.1. Számrendszerek

Római számok

Dear Mathgroup, 
Does Mathematica have any function to convert Arabic numerals to Roman, & vice versa? I' m thinking of something like

Roman[2007]-- -> MMVII

Arabic[MDCCLXIV]-- -> 1764

I just thought about that after seeing the date in the credits of an old movie, & I reckoned it' d
be faster to use Mathematica than use a convertor on the Web. I could not get any info from the Help browser or the archive. A Yes/No answer with a few words will do. I don' t really need a code. Unless someone has plenty of spare time.
Thanks.Ajit Sen.

Villegas

Dear Ajit

I think you will see many interesting things downloading the package and the notebook AntiqueNotations of Robby Villegas from here

Hyperlink["AntiqueNotations","http://library.wolfram.com/infocenter/Demos/4952/"]

Regards,
Dimitris

Szili :)

Dear Ajit, I also liked the proposed nb, but you might be still be interested in reading this small recursive program calculating Roman numerals (form our book with L.Szili, 1996).

ClearAll[arabic,roman,cap,ToRoman,IV,V,IX,X,XL,L,XC,CD,CM,M];arabic=Union[10^Range[0,3],Flatten[Outer[Times,{9,5,4},10^Range[0,2]]],{0}];
roman=ToString/@{{},I,IV,V,IX,X,XL,L,XC,C,CD,D,CM,M};
MapThread[SetDelayed,{ToRoman/@arabic,roman}];
cap[x_Integer/;0<x<4000]:=First[Select[Reverse[arabic],#<x&,1]];
ToRoman[x_Integer/;0<x<4000]:=SequenceForm[ToRoman[cap[x]],ToRoman[x-cap[x]]]

ToRoman/@(2^Range[0,12])

> Dear Janos,
> Thanks for sharing this code with us.
  > Ajit.
  > P.S. May I congratulate you for your definition of =
 > and := . It' s Super.There are minimum two - II/in Roman/-Janos - in this list. One of them janos - using janostothmeis ...@gmail.com e - mail who
provided the Roman Numerals code. All kudos should go for him.The other one is János - using janos.l ...@yale.edu e - mail who
provided the silly definition. All blames should go for him. János

kudos=dicsőség, hírnév

------------------------------------------"There was a mighty king in the land of the Huns whose goodness and
                    wisdom had no equal."
Nibelungen - Lied

4. A Mathematica programozásáról

5. Matematikán kívüli alkalmazások

5.2. Hang

Zenélgetnénk (Malina Jánostól)

Egyebek

Tally

Pick

Animate, EquationTrekker, Manipulate,

Arrow3D

Timing, AbsoluteTiming, Date[]

SystemInformation[]

Hyeperlink["ArcCosh","paclet:ref/ArcCosh"]

Dynamic, kurzor

DownValues,UpValues

Készen nincsen, csak kétdimenziós nyíl.

Egy megoldás

Csúnya a program, meg a nyíl.

Between[a_,b_,x_]:=b-(b-a)/Norm[b-a]*x;
Cone3D[s_,e_,w_]:=Module[{v,b,b1,b2,A,r},v=e-s;
A=RotationMatrix[π/10,v];
b={v[[2]],-v[[1]],0};
b=b/Norm[b]*w;
r={};
For[i=0,i<20,i++,b1=RotationMatrix[i*π/10,v].b;
b2=RotationMatrix[(i+1)*π/10,v].b;
AppendTo[r,Polygon[{e,s+b1,s+b2}]];
AppendTo[r,Polygon[{s,s+b1,s+b2}]];];
r];
Arrow3D[s_,e_,cw_,aw_,al_]:=Module[{m},m=Between[s,e,al];
{Cylinder[{s,m},cw],Cone3D[m,e,aw]}];

Graphics3D[{EdgeForm[],Arrow3D[{2,0,0},{0,0,0},0.1,0.3,0.4]}]

Graphics3D[{EdgeForm[],Arrow3D[{2,0,0},{0,0,0},0.01,0.1,0.6]}]

Másik megoldás

arrow3d[{x1_,y1_,z1_},{dx_,dy_,dz_}]:=arrow3d[{{x1,y1,z1},{x1+dx,y1+dy,z1+dz}}];
arrow3d[{x1_,y1_,z1_},d_]:=arrow3d[{{x1,y1,z1},{x1+d,y1+d,z1+d}}];
arrow3d[{{x1_,y1_,z1_},{x2_,y2_,z2_}}]:=Module[{vector,magnitud,normal,vectornormal,cruz,vectorbinormal},vector={x2-x1,y2-y1,z2-z1};
magnitud=Norm[vector];
normal={0,z1-z2,y2-y1};
vectornormal=magnitud*normal/Norm[normal];
cruz=Cross[vector,vectornormal];
vectorbinormal=magnitud*cruz/Norm[cruz];
{Cylinder[{{x1,y1,z1},{x1,y1,z1}+0.8 vector},0.01 magnitud],Polygon[{{x1,y1,z1}+0.8 vector+0.1 vectornormal,{x1,y1,z1}+0.8 vector-0.1 vectornormal,{x2,y2,z2}}],Polygon[{{x1,y1,z1}+0.8 vector+0.1 vectorbinormal,{x1,y1,z1}+0.8 vector-0.1 vectorbinormal,{x2,y2,z2}}]}];

Graphics3D[{Sphere[{1,1,1},0.2],arrow3d[{{1.5,1,1},{2,2,2}}],arrow3d[{{1.5,0,1},{-2,-2,2}}]},PlotRange->All]

Harnmadik megoldás

arrowhead3D[p_,n_]:=Module[{l=0.2,d=0.1,s=5},{EdgeForm[None],Table[Cylinder[{p-(i-1) l n/s,p-i l n/s},d i/s/2],{i,s}]}]

p={1,1,1};
n={1,1,1};
Graphics3D[{Point[p],Line[{{0,0,0},n}],arrowhead3D[p,n]}]

Negyedik megoldás

To draw 3 D arrows, the following packages are worth looking at :

.Harry Calkins'*MyGraphics`Arrow3D`*http://library.wolfram.com/infocenter/TechNotes/4117/

David Park' s*Presentations*package (for v6 and above)
or*DrawGraphics*(for v5 .2 and below)

http://home.comcast.net/~djmpark/Mathematica.html

Note that David Park' s packages are doing much more than just drawing 3 D
arrows! They define a simple yet powerful paradigm for drawing and
plotting with Mathematica.

Mátrix minorai

Hello,I'm trying to recode a script into Mathematica and am stuck.My problem in short:I need to calculate all minors of a matrix,but can't figure out a way
to get Mathematica to do more than just a specifically assigned minor at
a time (e.g.,the minor produce by removing column 1,row 1).My problem in long version:(I've posted an explanation with example matrices and links to the code I have written at http://home.uchicago.edu/~mnovak/mathematicahelp.html)

The original line is
T:=matrix(n,n,(i,j)->permanent(minor(abs(A),j,i))):evalm(T);

So,given a matrix A of dimensions n by n,determine the n x n different
minors of the|A|matrix (each minor being of size n-1 by n-1),then
calculate the permanent of each of these minors,and put the resultant
single value into the relevant position of an n by n matrix.That is,the permanent of the minor produced by removing the ith row and jth
column goes into position (i,j).First we need to define how we want the Minor of a matrix to be
calculated (Mathematica's "Minors" function does it in a way that we don't want.) Second,Mathematica doesn't have a function for calculating
a matrix's permanent,so we need to define that function.(Both of these I got from searching the the Mathgroup forum.)

Minor[m_List?MatrixQ,{i_Integer,j_Integer}]:=Abs[Drop[Transpose[A],{j}]],{i}]]
Permanent[m_List]:=With[{v=Array[x,Length[m]]},Coefficient[Times@@(m.v),Times@@v]]

Then the following does work....Minor[Abs[A],{1,3}]//MatrixForm
Permanent[Minor[Abs[A],{i,j}]]/.{i->1,j->1}

But the problem is that while I can do each of the Minor and Permanent
calculations for specified rows i& columns j of the matrix,I can't
figure out how to do all n x n possible combinations of i and j.Any suggestions would be much appreciated.Thanks!
-mark

--

Hi,Flatten[Outer[List,Table[i,{i,3}],Table[j,{j,3}]],1]

will find all possible combinations of {i,j} with i in[1,..,3] and
j in[1,..,3]

Regards
Jens

Recall Minors takes an optional third argument which is a function to
use in place of (default) Det.So you could use something like:unsignedCofactors[mat_?MatrixQ,k_]:=Module[{len=Length[mat],mn},(mn=Minors[mat,len-k,permanent];
Reverse[Map[Reverse,mn]])/;len≥k]

where permanent is as you indicated (or can be defined in other ways e.g.using recursion and memo-ization).permanent[mat_?MatrixQ]:=Module[{t,x},x=Array[t,Length[mat]];
Coefficient[Apply[Times,mat.x],Apply[Times,x]]]/;Length[mat]===Length[mat[[1]]]

Going from minors to cofactors is discussed in a section of the notebook at

http://library.wolfram.com/infocenter/Conferences/325/Daniel Lichtblau

Drop lines and columns in the reverse order and calculate the Array of
minors

Adjunct[x_?MatrixQ]:=Array[(-1)^(#1+#2)*Det[Drop[Transpose[Drop[x,{#2}]],{#1}]]&,Dimensions[x]]

B=Adjunct[A={{a,b,c},{d,e,f},{g,h,i}}]

{{-f h+e i,c h-b i,-c e+b f},{f g-d i,-c g+a i,c d-a f},{-e g+d h,b g-a h,-b d+a e}}

B.A/Det[A]==IdentityMatrix[3]//Simplify

True

--Roland Franzius

Hi Mark,use Outer:B=Outer[Permanent[Minor[Abs[A],{##}]]&,Sequence@@Range/@Dimensions[A],1]

hth,Peter

I show you how to calculate all the subdeterminants of the 3x3 matrix
A=2E
s=Subsets[Range[3]];
tr=Transpose[{s,s}];
A={{a,b,c},{d,e,f},{g,h,j}};
tap=Table[Apply[Part[A,##]&,tr=E3=80=9Ai=E3=80=9B],{i,2,2^3}](*UG=LY*)
If you wish you can calculat the detrminants (you would prefer permanents) of these submatrices as
Map[Det,tap]

1=2E I hope this helps.2=2E The UGLY step can be made much more elegantly,would need some
time.Janos

Zenélgetnénk (Malina Jánostól)

SoundNote["G", 1, "Violin"] gives you a middle G as if performed by a violinist corresponding to a predefined scale (should I know which?) It does not accept real numbers as a second variable. Play can play you any waveform. I would like to have the, say, violin profile but play a sound note at arbitrary pitch. How can I do this? The FullForm of SoundNote gives no information, and I do not want to invest a large amount of work into creating the appropriate profile if it has been done once.

SoundNote creates MIDI sound, which is quite distinct from the sampled sound created by Play. MIDI sound does have the concept of a "pitchbend" that can let you play
a note of arbitrary frequency, but this does not seem to have been implemented (yet?) in Mathematica MIDI sound.

Middle C is 0.

See the reference files.http://reference.wolfram.com/mathematica/ref/SoundNote.html
and
http://demonstrations.wolfram.com/MIDIKeyboardLimits/Hans

In private communication you stated that you want to experiment with
something like
http://demonstrations.wolfram.com/PythagoreanMeantoneAndEqualTemperam...

but with MIDI.At first I was hesitant to offer any ideas since it involves lots of time
and the proper equiment (soundcard or MIDI controller.) This all assumes
that the java MIDI driver has access to the sound cards MIDI banks.If it
does not then you should look into

http://java.sun.com/products/java-media/sound/soundbanks.html

If there is no java MIDI banks available the driver will try to find what is
available on your sound card.At which point this path may work for you:If you have a sound card that can take SoundFont;you can fill the memory
banks of your sound card (really using memory from your system).Properly
configured these sample sounds can be accessed in Mathematica using
SoundNote's function Style property.The style can take as document states
"Style {bank, patch, s} represents an instrument in the specified bank and
patch" and s between 1 and 128 represents of that bank.So this will no
longer be General MIDI instruments but sampled sounds or other MIDI
instruments that you placed in those banks.This all depends on the hard ware you have.On a PC with Creative compatible sound card there is software available to
load sample sound in the SoundFont format (by all means this is not the only format for sampled sound) But see

http://www.soundblaster.com/soundfont/downloads.asp

Now you can save a sample of a particular midi note instrument say "Violin"
and convert to.wav or.aif.Now if you process this wav file to change its
properties to your liking and load it into a MIDI bank and patch.If you
specify that sound bank and patch you should hear back the sampled sound.For that matter you can sample your voice load it into a MIDI bank and patch
and play it back
with SoundNote function in any MIDI Key.If your limited to what the Java synthesizer is capable of then I would look
into modifying the Java Synthesizer.Hans

Thank for all of you for the tips.I do not think I would learn MIDI (I did not even mentioned it,because I do not know what it is:))
or Java;neither would I start constructing my electronic musical
instrument;
I use Mathematica because I am NOT interested in low level programming,neither in hardware,I am interested in problem solving.Since there is no possibility to learn within Mathematica what Soundnote does,therefore what I could only do is to get the profiles of musical
instruments from the net,(the overtones:the addends in a finite Fourier expansion,if I understand well),and use Play to create,say,piano sounds with arbitrary pitch.