MathGroup Archive 2005

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

Search the Archive

Re: surface fitting question

  • To: mathgroup at smc.vnet.net
  • Subject: [mg61341] Re: surface fitting question
  • From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
  • Date: Sun, 16 Oct 2005 00:17:56 -0400 (EDT)
  • Organization: The Open University, Milton Keynes, UK
  • References: <diprth$hpc$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Ralph Smith wrote:
> I have this data in a file. It is a 2D table that 26 rows and  17 columns.
> 
>      |
> -----------------------------------------------------------------------
>      |   0.000    0.000   0.000   ...     0.000     0.000     0.000
>      |   0.050    0.050   0.155   ...    16.409    19.375    20.156
>      |                       .
>      |                       .
>      |                       .
>      |  47.500  50.000  55.000   ...   2017.500  2075.580  2182.765
> -----------------------------------------------------------------------
>      |
> 
> I would like to find an equation that describes this surface using
> mathematica. I think that 3rd degree polynomials would be what I'm looking
> for. So, maybe
>    data[x,y] = ax^3 + bx^2 + cx + d + ey^3 + fy^2 + gy
> 
> I've seen and example that uses Fit[], so I think this can be done, but I'm
> a novice at mathematica and don't know how to set this problem up. I have been
> able to fit a polynomial to curve data, but now I need to fit a surface.
> 
> thanks,
> Ralph
> 
> 
> 
Hi Ralph,

Just to complete my previous answer. Assuming that the x-, y-coordinates 
are the row and column numbers respectively, you could use the following 
process -- summarized as one line at the end -- to transform your data 
set into a list of three coordinates as required by *Fit*.

First we define two parameters containing the max number of rows and 
columns to be found in the data set:

In[1]:=
nRow = 5;
nCol = 4;

Then we generate some sample data

In[3]:=
data = Table[Table[Random[Real, {0, 2500}], {nCol}], {nRow}]

Out[3]=
{{1069.45,1951.84,2288.3,1903.68},{1031.85,2048.23,1035.9,1059.63},{
   893.347,883.253,423.135,514.3},{1729.97,1901.79,1513.78,2397.94},{
   2402.13,1341.47,1300.56,883.788}}

Then we use several built-in Mathematica function to insert the x- and 
y-coordinates

In[4]:=
Flatten[data]

Out[4]=
{1069.45,1951.84,2288.3,1903.68,1031.85,2048.23,1035.9,1059.63,893.347,883.\
253,423.135,514.3,1729.97,1901.79,1513.78,2397.94,2402.13,1341.47,1300.56,883.\
788}

In[5]:=
xycoord = Table[Table[{i, j}, {j, nCol}], {i, nRow}]

Out[5]=
{{{1,1},{1,2},{1,3},{1,4}},{{2,1},{2,2},{2,3},{2,4}},{{3,1},{3,2},{
     3,3},{3,4}},{{4,1},{4,2},{4,3},{4,4}},{{5,1},{5,2},{5,3},{5,4}}}

In[6]:=
Flatten[xycoord, 1]

Out[6]=
{{1,1},{1,2},{1,3},{1,4},{2,1},{2,2},{2,3},{2,4},{3,1},{3,2},{3,3},{3,4},{
   4,1},{4,2},{4,3},{4,4},{5,1},{5,2},{5,3},{5,4}}

In[7]:=
MapThread[List, {Flatten[xycoord, 1], Flatten[data]}]

Out[7]=
{{{1,1},1069.45},{{1,2},1951.84},{{1,3},2288.3},{{1,4},1903.68},{{
   2,1},1031.85},{{2,2},2048.23},{{2,3},
 
1035.9},{{2,4},1059.63},{{3,1},893.347},{{3,2},883.253},{{3,3},423.135},\
{{3,4},514.3},{{4,1},1729.97},{{4,2},1901.79},{{4,3},1513.78},{{4,4},2397.94},\
{{5,1},2402.13},{{5,2},1341.47},{{5,3},1300.56},{{5,4},883.788}}

In[8]:=
Flatten[%, 2]

Out[8]=
{1,1,1069.45,1,2,1951.84,1,3,2288.3,1,4,1903.68,2,1,1031.85,2,2,2048.23,2,3,\
1035.9,2,4,1059.63,3,1,893.347,3,2,883.253,3,3,423.135,3,4,514.3,4,1,1729.97,\
4,2,1901.79,4,3,1513.78,4,4,2397.94,5,1,2402.13,5,2,1341.47,5,3,1300.56,5,4,\
883.788}

In[9]:=
Partition[%, 3]

Out[9]=
{{1,1,1069.45},{1,2,1951.84},{
   1,3,2288.3},{1,4,1903.68},{2,1,1031.85},{2,2,2048.23},{2,3,
     1035.9},{2,4,1059.63},{3,1,893.347},{3,2,883.253},{
   3,3,423.135},{3,4,514.3},{4,1,1729.97},{4,2,1901.79},{
   4,3,1513.78},{4,4,2397.94},{5,1,2402.13},{5,2,1341.47},{
   5,3,1300.56},{5,4,883.788}}

Okay! Now we have the correct structure that can be used by *Fit* We can 
do all these operations in just one line, as follows

In[10]:=
Partition[Flatten[MapThread[List,
     {Flatten[Table[Table[{i, j}, {j, nCol}], {i, nRow}], 1], 
Flatten[data]}],
    2], 3]

Out[10]=
{{1,1,1069.45},{1,2,1951.84},{
   1,3,2288.3},{1,4,1903.68},{2,1,1031.85},{2,2,2048.23},{2,3,
     1035.9},{2,4,1059.63},{3,1,893.347},{3,2,883.253},{
   3,3,423.135},{3,4,514.3},{4,1,1729.97},{4,2,1901.79},{
   4,3,1513.78},{4,4,2397.94},{5,1,2402.13},{5,2,1341.47},{
   5,3,1300.56},{5,4,883.788}}

and check that *Fit* works correctly with them

In[11]:=
Fit[%, {x^3, x^2, x, 1, y^3, y^2, y}, {x, y}]

Out[11]=
2986.4585080606907 - 3837.065481375177*x + 1274.2243266436349*x^2 - 
125.43912287672083*x^3 +
   2556.0734957643067*y - 1121.9379403564901*y^2 + 144.24393149981609*y^3

Hope this helps,
/J.M.


  • Prev by Date: Getting a pure text widget?
  • Next by Date: Re: problem solving polynomial equations
  • Previous by thread: Re: surface fitting question
  • Next by thread: Re: surface fitting question