Related
Please, help me to understand...
Im solving system of equations
`f1[\[Lambda]1_, t_] := \[Lambda]1*Exp[-\[Lambda]1*t];
f2[\[Lambda]2_, t_] := \[Lambda]2*Exp[-\[Lambda]2*t];
f3[\[Lambda]3_, t_] := \[Lambda]3*Exp[-\[Lambda]3*t];
f4[\[Lambda]4_, t_] := \[Lambda]4*Exp[-\[Lambda]4*t];
f5[\[Lambda]5_, t_] := \[Lambda]5*Exp[-\[Lambda]5*t];
f6[\[Lambda]6_, t_] := \[Lambda]6*Exp[-\[Lambda]6*t];
f7[\[Lambda]7_, t_] := \[Lambda]7*Exp[-\[Lambda]7*t];
f8[\[Lambda]8_, t_] := \[Lambda]8*Exp[-\[Lambda]8*t];
f9[\[Lambda]9_, t_] := \[Lambda]9*Exp[-\[Lambda]9*t];
f10[\[Lambda]10_, t_] := \[Lambda]10*Exp[-\[Lambda]10*t];`
`p = ( {
{0, 1, 0, 0, 0, 0, 0},
{0, 0, 1, 0, 0, 0, 0},
{0, 0.3, 0, 0.6, 0.1, 0, 0},
{0, 0.4, 0, 0, 0.1, 0.5, 0},
{0, 0, 0, 0, 0, 0, 1},
{0, 0, 0, 0, 0, 0, 1},
{0, 0, 0, 0, 0, 0, 0}
} );`
`fun[t_] := ( {
{0, f1[1/6, t], 0, 0, 0, 0, 0},
{0, 0, f2[1/2, t], 0, 0, 0, 0},
{0, f6[1/1, t], 0, f4[1/1, t], f3[1/1, t], 0, 0},
{0, f7[1/5, t], 0, 0, f5[1/2, t], f8[1/8, t], 0},
{0, 0, 0, 0, 0, 0, f9[1, t]},
{0, 0, 0, 0, 0, 0, f10[1, t]},
{0, 0, 0, 0, 0, 0, 0}
} );`
`T := 0.01;
q[t_] := p*fun[t];
q[t] // MatrixForm
r[n_] := Table[
q[n*T][[k, j]] +
Sum[Sum[T*q[n*T - i*T][[m, j]]*Subscript[\[Phi], m][i*T], {i, 0,
n}], {m, 1, 7}], {j, 1, 7}, {k, 1}];
r[1] // MatrixForm
aa[n_] :=
Table[Subscript[\[Phi], j][n*T] == r[n][[j, 1]], {j, 1, 7}];
bb[n_] := Table[Subscript[\[Phi], j][n*T], {j, 1, 7}];`
Sol[n_] := Solve[aa[n], bb[n]] /. Solve[aa[n - 1], bb[n - 1]];
Sol[1] // MatrixForm
I have values for Sol[0] and Sol[1], but for Sol[2], Sol[3], etc. Mathematica don't substitute previous values...
`
I solved this system in Laplace domain. I tried to obtain the values in range from 0 to 50.
Hello! Help me please to make a procedure from my program code.
I've got code, which includs 2 parts (they're Graphics[...]), it plots functions with rectengles.
But it seems to be too much code, so I have to write a procedure with an argument of a function and then when I call it, this procedure would do the same (plots functions with rectengles). (can somehows to use spx1,spx2.)
This is whole code:
(*Sin[x]*)
data1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
data11 = data1[[;; , 2]];(*отримуємо набір ординат*)localmins1 =
Pick[data1, MinDetect[data11, 10^-6], 1];
localmaxs1 = Pick[data1, MaxDetect[data11, 10^-6], 1];
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1]}, Axes -> True];
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1],
Point[{{-1, 0}, {1.6, 0}, {-0.35, 0}, {0.3, 0}, {0.95, 0}}], Green,
Point[{{-0.35, -0.1342898}, {0.3, 0.29552}, {0.95, 0.813416}}], Red,
Point[{{2.375, 0}, {3.15, 0}, {3.925, 0}, {4.7, 0}}], Green,
Point[{{2.375, 0.693685}, {3.15, -0.0084}, {3.925, -0.70569766}}],
Pink, Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-1, -0.84147}, {-0.35, -0.342898}],
Rectangle[{-0.35, -0.342898}, {0.3, 0.29552}],
Rectangle[{0.3, 0.29552}, {0.95, 0.813416}],
Rectangle[{0.95, 0.813416}, {1.6`, 0.9995736030415051`}],
Rectangle[{1.6, 0.99957}, {2.375, 0.693685}],
Rectangle[{2.375, 0.693685}, {3.15, -0.0084}],
Rectangle[{3.15, -0.0084}, {3.925, -0.70569766}],
Rectangle[{3.925, -0.70569766}, {4.7, -0.9999}],}, Axes -> True]
(*Cos[x]*)
data2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}]; data22 =
data2[[;; , 2]];(*отримуємо набір ординат*)localmins2 =
Pick[data2, MinDetect[data22, 10^-6], 1];
localmaxs2 = Pick[data2, MaxDetect[data22, 10^-6], 1];
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2]}, Axes -> True];
spx2 = {-3,-2.25, -1.5, -0.75,0, 0.75, 1.5, 2.25, 3};
spxrozb11 = {-3, -2.25, -1.5, -0.75, 0};
spxrozb22 = {0, 0.75, 1.5, 2.25, 3};
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2],
Point[{{-2.25, 0}, {-1.5, 0}, {-0.75, 0}, {0, 0}}], Green,
Point[{{-2.25, -0.628}, {-1.5, 0.07}, {-0.75, 0.73}}], Red,
Point[{{0.75, 0}, {1.5, 0}, {2.25, 0}, {3, 0}}], Green,
Point[{{0.75, 0.7316}, {1.5, 0.07}, {2.25, -0.628}}], Pink,
Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-3, -0.989992}, {-2.25, -0.628}],
Rectangle[{-2.25, -0.628}, {-1.5, 0.07}],
Rectangle[{-1.5, 0.07}, {-0.75, 0.7316}],
Rectangle[{-0.75, 0.7316}, {1.6653345369377348`*^-16, 1.`}],
Rectangle[{1.6653345369377348`*^-16, 1.`}, {0.75, 0.7316}],
Rectangle[{0.75, 0.7316}, {1.5, 0.07}],
Rectangle[{1.5, 0.07}, {2.25, -0.628}],
Rectangle[{2.25, -0.628}, {3.1000000000000005`, \
-0.9991351502732795`}]}, Axes -> True]
I tried to write the first step in procedure, and even it doesn't work;(
f1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
f2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}];
data = {f1, f2};
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
graph[i_] :=
Graphics[For[i = 0, i < 3,
i++, {Thick, Blue, Line[data[[i]]], Red, Point[{spx1[[i]], 0}]}]]
graph[1]
******How to write For in procedure correctly?******
I want to calculate an 2D array "tocalc" in which the elements are calculated based on tests on three other lists (z,b1,b2).
(*example data*)
z = Range[0, 100, 10];
x = Range[10];
b1 = ConstantArray[0., Length[x]];
tocalc = ConstantArray[0, {Length[x], Length[z]}];
b2 = {0, 20, 30, 40, 50, 40, 30, 20, 10, 0};
one solution to this would be
(*simple but slow solution*)
Do[
Do[
If[z[[k]] <= b2[[i]] && z[[k]] >= b1[[i]],
tocalc[[i, k]] = (b2[[i + 1]] - b2[[i - 1]])],
{k, 1, Length[z]}];,
{i, 2, Length[x] - 1}]
with the result
{{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {30, 30, 30, 0, 0, 0, 0, 0, 0, 0,
0}, {20, 20, 20, 20, 0, 0, 0, 0, 0, 0, 0}, {20, 20, 20, 20, 20, 0,
0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, -20, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, 0, 0, 0, 0, 0, 0, 0}, {-20, -20, -20, 0, 0,
0, 0, 0, 0, 0, 0}, {-20, -20, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0}}
The Question: How can this be done efficiently in Mathematica?
If this is evaluated 10000 times then it would take then 3.66 seconds. While in Matlab this takes 0.04sec so Matlab is almost 100 times faster.
I know that the solution with the two Do loops is not perfect for Mathematica, so i tried several other solutions such as with MapIndexed, Table, functions, Conditionals, and so on. but all are not really faster maybe even slower the the two Do loops.
Here is one example with MapIndexed:
tocalc = ConstantArray[0, {Length[x], Length[z]}];
MapIndexed[
If[z[[Part[#2, 2]]] <= b2[[Part[#2, 1]]] &&
z[[Part[#2, 2]]] >= b1[[Part[#2, 1]]] && Part[#2, 1] >= 2 &&
Part[#2, 1] <= Length[x] - 1,
tocalc[[Part[#2, 1], Part[#2, 2]]] = (b2[[Part[#2, 1] + 1]] -
b2[[Part[#2, 1] - 1]]), 0.] &, tocalc, {2}];
The ideal solution should work for larger matrices and real numbers as well and also for more complicated conditionals.
---edit:
Since it looks some solutions to this are even slower in my real problem here is one example of it:
the Real-World Problem
b2 = {0.`, 0.`, 0.`, 990.3440201085594`, 1525.7589030785484`,
1897.6531659202747`, 2191.6073263357594`, 2433.0441988616717`,
2630.6658409463894`, 2799.347578394955`, 2944.656306810331`,
3070.718467691769`, 3179.485627984329`, 3272.3788096129415`,
3346.199103579602`, 3405.384848015466`, 3346.199103579602`,
3272.3788096129415`, 3179.485627984329`, 3070.718467691769`,
2944.656306810331`, 2799.347578394955`, 2630.6658409463894`,
2433.0441988616717`, 2191.6073263357594`, 1897.6531659202747`,
1525.7589030785484`, 990.3440201085594`, 0.`, 0.`, 0.`};
z = {0.`, 250.`, 500.`, 750.`, 1000.`, 1250.`, 1500.`, 1750.`, 2000.`,
2250.`, 2500.`, 2750.`, 3000.`, 3250.`,
3500.`}; (*z(k)*)
imax = 31; (*number of x(i)*)
b1 = ConstantArray[0., imax]; (*lower boundary, can be different form 0*)
deltax = 50000.`;
mmax = 10000.; (*number of calculations*)
A00 = 1.127190283243198`*^-12; (*somefactor*)
n = 3;
one solution:
f2C = Compile[{{b2, _Real, 1}, {z, _Real, 1}, {b1, _Real, 1}},
With[{zeros = {ConstantArray[0., Length[z]]}},
Join[zeros,
Table[If[
b1[[i]] <= z[[k]] <=
b2[[i]], -(A00*(Abs[(b2[[i + 1]] - b2[[i - 1]])/(2.0*
deltax)])^(n -
1.0)*(b2[[i]]^(n + 1.) - (b2[[i]] - z[[k]])^(n +
1.)))*((b2[[i + 1]] - b2[[i - 1]])/(2.0*deltax))
, 0.],
{i, 2, Length[b2] - 1}, {k, Length[z]}
], zeros]]
, CompilationTarget -> "C"];
The Result is
Timing[Do[f2C[b2, z, b1];, {mmax}]]
Out[85]= {81.3544, Null}
Thanks!
You can do something like below. You will need to figure out how you want to handle the boundaries though (where b2[[i+1]] or b2[[i-1]] is not defined).
f[x_, y_] := If[x[[1]] <= y <= x[[2]], x[[4]] - x[[3]], 0]
Here I restrain the level to which Outer goes, so that I do not need to change the head (as I was doing in the original response).
In[1309]:= Outer[f,
Transpose[{b1, b2, RotateRight[b2], RotateLeft[b2]}], z, 1]
Out[1309]= {{20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {30, 30, 30, 0, 0, 0,
0, 0, 0, 0, 0}, {20, 20, 20, 20, 0, 0, 0, 0, 0, 0, 0}, {20, 20, 20,
20, 20, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, -20, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, 0, 0, 0, 0, 0, 0, 0}, {-20, -20, -20, 0, 0,
0, 0, 0, 0, 0, 0}, {-20, -20, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {-10, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0}}
Speed check:
In[1298]:= Timing[
Do[Outer[f,
Apply[list,
Transpose[{b1, b2, RotateRight[b2], RotateLeft[b2]}], {1}],
z], {10^4}]]
Out[1298]= {2.68, Null}
We can compile the function to get better speed.
fC = Compile[{{x, _Integer, 1}, {y, _Integer}},
If[x[[1]] <= y <= x[[2]], x[[4]] - x[[3]], 0]];
In[1306]:= Timing[
Do[Outer[fC, Transpose[{b1, b2, RotateRight[b2], RotateLeft[b2]}], z,
1], {10^4}]]
Out[1306]= {0.8, Null}
--- edit ---
Variants include compiling the entire routine. Here is one such.
ff = Compile[{{b1, _Integer, 1}, {b2, _Integer, 1}, {z, _Integer,
1}},
With[{lc =
RotateRight[ListConvolve[{1, 0, -1}, b2, {-1, -1}, 0]]},
Table[
If[b1[[i]] <= z[[k]] <= b2[[i]], lc[[i]], 0], {i,
Length[b2]}, {k, Length[z]}
]]];
In[385]:= Timing[Do[ff[b1, b2, z], {10^4}]]
Out[385]= {0.24, Null}
If I add CompilationTarget -> "C" then it gets around twice as fast.
Another variant, in C code, gets under 0.1 seconds.
In[441]:=
ff2C = Compile[{{b1, _Integer, 1}, {b2, _Integer, 1}, {z, _Integer,
1}},
With[{zeros = {ConstantArray[0, Length[z]]}},
Join[zeros, Table[
If[b1[[i]] <= z[[k]] <= b2[[i]], b2[[i + 1]] - b2[[i - 1]],
0], {i, 2, Length[b2] - 1}, {k, Length[z]}
], zeros]], CompilationTarget -> "C"];
In[442]:= Timing[Do[ff2C[b1, b2, z], {10^4}]]
Out[442]= {0.04, Null}
In[443]:= ff2C[b1, b2, z]
Out[443]= {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {30, 30, 30, 0, 0, 0, 0,
0, 0, 0, 0}, {20, 20, 20, 20, 0, 0, 0, 0, 0, 0, 0}, {20, 20, 20,
20, 20, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, -20, 0, 0, 0, 0, 0,
0}, {-20, -20, -20, -20, 0, 0, 0, 0, 0, 0, 0}, {-20, -20, -20, 0, 0,
0, 0, 0, 0, 0, 0}, {-20, -20, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0}}
I would guess there are variants that may be faster still.
--- end edit ---
--- edit 2 ---
Of course, if you have global variables (that is, defined outside of your Compile), then there is a bit more work to do. I am aware of two possibilities. Prior to version 8 one would suck in constants using a With[] around the Compile, as below.
f2C = With[{n = n, deltax = deltax, A00 = A00},
Compile[{{b2, _Real, 1}, {z, _Real, 1}, {b1, _Real, 1}},
With[{zeros = {ConstantArray[0., Length[z]]}},
Join[zeros,
Table[If[
b1[[i]] <= z[[k]] <=
b2[[i]], -(A00*(Abs[(b2[[i + 1]] - b2[[i - 1]])/(2.0*
deltax)])^(n -
1.0)(b2[[i]]^(n + 1.) - (b2[[i]] - z[[k]])^(n +
1.)))((b2[[i + 1]] - b2[[i - 1]])/(2.0*deltax)),
0.], {i, 2, Length[b2] - 1}, {k, Length[z]}], zeros]],
CompilationTarget -> "C"]];
In version 8 the following achieves the same effect.
f2Cb = Compile[{{b2, _Real, 1}, {z, _Real, 1}, {b1, _Real, 1}},
With[{zeros = {ConstantArray[0., Length[z]]}},
Join[zeros,
Table[If[
b1[[i]] <= z[[k]] <=
b2[[i]], -(A00*(Abs[(b2[[i + 1]] - b2[[i - 1]])/(2.0*
deltax)])^(n -
1.0)(b2[[i]]^(n + 1.) - (b2[[i]] - z[[k]])^(n +
1.)))((b2[[i + 1]] - b2[[i - 1]])/(2.0*deltax)),
0.], {i, 2, Length[b2] - 1}, {k, Length[z]}], zeros]],
CompilationTarget -> "C",
CompilationOptions -> {"InlineExternalDefinitions" -> True}];
With either I get a result on the more realistic example in around 0.7 seconds, whereas my machine would take over 100 seconds without those globals being defined inside the Compile.
A more general approach might be to pass them as parameters (if they were likely to change rather than be constants). That would lead to a slightly slower run time though.
Regarding that option approach, you might have a look at ref/CompilationOptions in the Cocumentation Center
--- end edit 2 ---
I have an ODE and I solve it with NDSolve, then I plot the solution on a simplex in 2D.
Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg
Then I need to transform (align or just plot) this simplex in 3D at coordinates (1,0,0),(0,1,0),(0,0,1), so it looks like this scheme:
Valid XHTML http://ompldr.org/vY2dhMg/simps.png
I use ParametricPlot to do my plot so far. Maybe all I need is ParametricPlot3D, but I don't know how to call it properly.
Here is my code so far:
Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40, betaf = 0.60, betam = 0.1,
betaf = 0.1, sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;
solhelp =
Table[
NDSolve[
Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
AccuracyGoal -> 10, PrecisionGoal -> 15],
{a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];
functions =
Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];
ParametricPlot[Evaluate[functions], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]
Third day with Mathematica...
You could find a map from the triangle in the 2D plot to the one in 3D using FindGeometricTransformation and use that in ParametricPlot3D to plot your function, e.g.
corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]],
PadRight[#, 3] & /# Append[pts1, Mean[pts1]],
"Transformation" -> "Affine"][[2]]
ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & ### functions],
{t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
Since your solution has the property that x2[t]+y2[t]+p2[t]==1 it should be enough to plot something like:
functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];
ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
I am currently visualizing word and phrase frequency across a large database of textual information (approximately 108MB spread across 307 text files). My goal is to have a way to quickly see what files are the most relevant and in a visually attractive format (although this project will probably also demonstrate that just having textual representation is always clearer).
Right now I have the following:
SetDirectory["/MYMATHEMATICADIRECTORY/"];
filelist = FileNames[];
viewerCount1 = {0};
viewerCount2 = {0};
word1 = "freedom";
word2 = "liberty";
Do[
searchDB = StringSplit[Import[filename]];
AppendTo[viewerCount1, Count[searchDB, word1]];
AppendTo[viewerCount2, Count[searchDB, word2]];
, {filename, filelist}]
list3 = Take[viewerCount1, {2, -1}]
list4 = Take[viewerCount2, {2, -1}]
The FileNames[ ] generates a list such as: {"001ABbenevolat.txt-cleaned.txt", "002abnature.txt-cleaned.txt", "003aboriginaldocs.txt-cleaned.txt", "004ABpresse.txt-cleaned.txt", "005acadian.txt-cleaned.txt", "006acadiedelile.txt-cleaned.txt","007acfa.txt-cleaned.txt"} [except with 307 entries, all numbered].
list3 generates a list such as: {0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 100, 2, 0, 0, 0, 10, 1, 7, 0, 0, 0, 0, 23, 3, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 9, 0, 1, 0, 1, 0, 5, 0, 13, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 0, 4, 0, 0, 0, 1, 11, 0, 2, 0, 0, 2, 7, 1, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 13,...} and so on.
The command:
BarChart3D[{list3, list4}, BarSpacing -> {0.5, 0}, ChartLayout -> "Grid"]
Generates something close to what I want (imagining them as file folders sticking up). However, I want to add meaningful tool-tips. By default, it comes up with frequency. Would there be a quick way to also include the filename the frequency is attached to, as well as the frequency? i.e. a tool-tip that brings up '007acfa.txt-cleaned.txt -- 32' where 32 occurrences appear in file 7?
As an example, suppose you data is something like
list3 = RandomInteger[30, 30];
list4 = RandomInteger[30, 30];
filelist = Table["file " <> ToString[i], {i, 30}];
Then you could do something like
BarChart3D[{
MapThread[Tooltip[#2, Row[{#, " -- ", #2}]] &, {filelist, list3}],
MapThread[Tooltip[#2, Row[{#, " -- ", #2}]] &, {filelist, list4}]},
BarSpacing -> {0.5, 0}, ChartLayout -> "Grid"]
Edit
Another way is to use LabelingFunction:
BarChart3D[{list3, list4},
LabelingFunction ->
(Placed[Row[{filelist[[Last[#2]]], " -- ", #1}], Tooltip] &),
ChartLayout -> "Grid", BarSpacing -> {0.5, 0}]
This should work:
BarChart3D[{list3, list4},
ChartLabels -> Placed[filelist, Tooltip],
ChartLayout -> "Grid",
BarSpacing -> {0.5, 0}]
Edit
Forgot you wanted the height in the tooltip also, for which you do want to use LabelingFunction. Let's go ahead and include the word itself also:
BarChart3D[{list3, list4},
ChartLabels -> {Placed[{word1, word2}, None], Placed[filelist, None]},
ChartLayout -> "Grid",
BarSpacing -> {0.5, 0},
LabelingFunction -> (Tooltip[Row[Flatten[{#3, #1}], " - "]] &)
]