source: sans/Analysis/branches/ajj_23APR07/IGOR_Package_Files/Put in User Procedures/SANS_Models_v3.00/Packages/Wrapper.ipf @ 151

Last change on this file since 151 was 151, checked in by srkline, 15 years ago

(1) - cursors can now be used to select a subrange of USANS data to fit. This is done by th fit wrapper, assigning a subrange of resW to the struct

(2) all of the smeared model functions are now in the latest form of Smear_Model_N() that is NOT a pointwise calculation anymore, since the USANS matrix smearing in inherently not so.

File size: 12.3 KB
Line 
1#pragma rtGlobals=1             // Use modern global access method.
2
3
4//
5//
6//
7//
8////////
9//
10// if model is Smeared, search the DF for coefficients
11// if new DF chosen, need to reset
12// if new model function, need to reset table
13//
14// create hold_mod (0/1), constr_low_mod, constr_hi_mod
15// in either DF (smeared) or in root: (normal)
16// and put these in the table as needed
17//
18Window WrapperPanel() : Panel
19        PauseUpdate; Silent 1           // building window...
20        NewPanel /W=(459,44,1113,499)/N=wrapperPanel as "Curve Fit Setup"
21       
22        GroupBox grpBox_0,pos={18,11},size={350,113}
23        Button button_0,pos={519,134},size={100,20},proc=DoTheFitButton,title="Do The Fit"
24        PopupMenu popup_0,pos={30,21},size={218,20},title="Data Set"
25        PopupMenu popup_0,mode=1,value= #"DataSetPopupList()"
26        PopupMenu popup_1,pos={30,57},size={136,20},title="Function"
27        PopupMenu popup_1,mode=1,value= #"W_FunctionPopupList()"
28        PopupMenu popup_2,pos={30,93},size={123,20},title="Coefficients"
29        PopupMenu popup_2,mode=1,value= #"W_CoefPopupList()",proc=Coef_PopMenuProc
30        CheckBox check_0,pos={411,22},size={79,14},title="Use Cursors?",value= 0
31        CheckBox check_1,pos={412,45},size={74,14},title="Use Epsilon?",value= 0
32        CheckBox check_2,pos={412,68},size={95,14},title="Use Constraints?",value= 0
33        CheckBox check_3,pos={280,24},size={72,14},title="From target",value= 0
34        Edit/W=(20,174,634,435)/HOST=# 
35        ModifyTable width(Point)=0
36        RenameWindow #,T0
37        SetActiveSubwindow ##
38EndMacro
39
40
41// is there a simpler way to do this?
42Function/S DataSetPopupList()
43
44        String str=GetAList(4),tmp="",onTargetStr=""
45        Variable ii
46        ControlInfo check_3
47        if(V_Value==1)          //if "from target" checked
48                //ther must be a better way to do this
49                onTargetStr = TraceNameList("",";",1)
50                onTargetStr = ReplaceString("_i",onTargetStr,"")                //get rid of the "_i"
51                for(ii=0;ii<ItemsInList(onTargetStr);ii+=1)
52                        if(WhichListItem(StringFromList(ii,onTargetStr,";"), str  , ";") != -1)
53                                tmp = Addlistitem(StringFromList(ii,onTargetStr,";"),tmp)               //only keep the matches w/data folder listing
54                        endif
55                endfor
56                return(tmp)
57        endif
58
59        if(strlen(str)==0)
60                str = "No data loaded"
61        endif
62        return(str)
63End
64
65
66// show the available models
67// but not the smeared versions
68// not the f*
69// not the *X XOPS
70//
71// KIND:10 should show only user-defined curve fitting functions
72// - not XOPs
73// - not other user-defined functions
74Function/S W_FunctionPopupList()
75        String list,tmp
76        list = FunctionList("*",";","KIND:10")          //get everything
77       
78        list = RemoveFromList("Sum_Model", list  ,";")
79       
80        tmp = FunctionList("*_proto",";","KIND:10")             //prototypes
81        list = RemoveFromList(tmp, list  ,";")
82
83        tmp = FunctionList("f*",";","KIND:10")          //point calculations
84        list = RemoveFromList(tmp, list  ,";")
85       
86        // this should be a null string with KIND:10
87        tmp = FunctionList("*X",";","KIND:10")          //XOPs, also point calculations
88        list = RemoveFromList(tmp, list  ,";")
89       
90        if(strlen(list)==0)
91                list = "No functions plotted"
92        endif
93        return(list)
94End
95
96// show all the appropriate coefficient waves
97//
98// also need to search the folder listed in "data set" popup
99// for smeared coefs
100//
101// - or - restrict the coefficient list based on the model function
102//
103Function/S W_CoefPopupList()
104        String list
105        setDataFolder root:
106        list = WaveList("coef*",";","")
107       
108        ControlInfo popup_0
109        if(V_Value != 0)                //0== no items in menu
110                if(DataFolderExists("root:"+S_Value))
111                        SetDataFolder $("root:"+S_Value)
112                        list += WaveList("*coef*",";","")
113                endif
114        endif
115       
116        if(strlen(list)==0)
117                list = "No functions plotted"
118        endif
119        setDataFolder root:
120        return(list)
121End
122
123// if the coefficients are changed, then update the table
124//
125//update the table
126// may be easier to just kill the subwindow (table) and create a new one
127// need to set/reset all of the waves in the table
128//
129// !! only respond to mouse up
130//
131Function Coef_PopMenuProc(pa) : PopupMenuControl
132        STRUCT WMPopupAction &pa
133
134        switch( pa.eventCode )
135                case 2: // mouse up
136                        Variable popNum = pa.popNum
137                        String popStr = pa.popStr
138                        String suffix = getModelSuffix(popStr)
139                        ControlInfo popup_0
140                        String folderStr=S_Value
141                       
142                        if(DataFolderExists("root:"+folderStr))
143                                SetDataFolder $("root:"+folderStr)
144                                if(!exists(popStr))
145                                        // must be unsmeared model, work in the root folder
146                                        SetDataFolder root:                             
147                                        if(!exists(popStr))             //this should be fine if the coef filter is working, but check anyhow
148                                                DoAlert 0,"the coefficient and data sets do not match"
149                                                return 0
150                                        endif
151                                endif
152                        else
153                                return(0)               //get out
154                        endif
155                       
156                        // farm the work out to another function?
157                        Variable num=numpnts($popStr)
158                        // make the necessary waves
159                        Make/O/D/N=(num) $("epsilon"+suffix),$("Hold"+suffix)
160                        Make/O/T/N=(num) $("LoLim"+suffix),$("HiLim"+suffix)
161                       
162                        // default epsilon values, sometimes needed for the fit
163                        Wave eps = $("epsilon"+suffix)
164                        Wave coef=$popStr
165                        eps = abs(coef*1e-4) + 1e-10                    //default eps is proportional to the coefficients
166                        WAVE/T LoLim = $("LoLim"+suffix)
167                        WAVE/T HiLim = $("HiLim"+suffix)
168                        LoLim = ""              //should have nicer way of keeping the previous values
169                        HiLim = ""
170                       
171                        // clear the table (a subwindow)
172                        KillWindow wrapperPanel#T0
173                        Edit/W=(20,174,634,435)/HOST=#
174                        RenameWindow #,T0
175                        // get them onto the table
176                        // how do I get the parameter name?
177                        String param = WaveList("*param*"+suffix, "", "TEXT:1," )               //this is *hopefully* one wave
178                        AppendtoTable/W=wrapperPanel#T0 $param,$(popStr)
179                        AppendToTable/W=wrapperPanel#T0 $("Hold"+suffix),$("LoLim"+suffix),$("HiLim"+suffix),$("epsilon"+suffix)
180                        ModifyTable width(Point)=0
181                       
182                        SetDataFolder root:
183                        break
184        endswitch
185
186        return 0
187End
188
189Function/S getModelSuffix(modelStr)
190        String modelStr
191       
192        Variable pos=Strsearch(modelStr,"_",Inf,1)              //look backwards to find "_"
193       
194        return(modelStr[pos,strlen(modelStr)-1])
195End
196
197// this should parse the panel and call the FitWrapper() function
198Function DoTheFitButton(ba) : ButtonControl
199        STRUCT WMButtonAction &ba
200
201        String folderStr,funcStr,coefStr
202        Variable useCursors,useEps,useConstr
203       
204        switch( ba.eventCode )
205                case 2: // mouse up
206                        ControlInfo popup_0
207                        folderStr=S_Value
208                       
209                        ControlInfo popup_1
210                        funcStr=S_Value
211                       
212                        ControlInfo popup_2
213                        coefStr=S_Value
214                       
215                        Controlinfo check_0
216                        useCursors=V_Value
217                        Controlinfo check_1
218                        useEps=V_Value
219                        Controlinfo check_2
220                        useConstr=V_Value
221                       
222                        FitWrapper(folderStr,funcStr,coefStr,useCursors,useEps,useConstr)
223                       
224                        //      DoUpdate (does not work!)
225                        //?? why do I need to force an update ??
226                        if(!exists("root:"+folderStr+":"+coefStr))
227                                Wave w=$coefStr
228                        else
229                                Wave w=$("root:"+folderStr+":"+coefStr) //smeared coefs in data folder
230                        endif
231                        w[0] += 1e-6
232                        w[0] -= 1e-6
233       
234                        break
235        endswitch
236       
237        return 0
238End
239
240
241/////////////////////////////////
242
243// wrapper to do the desired fit
244//
245// folderStr is the data folder for the desired data set
246//
247// -- this looks like something that can be made rather generic rather easily
248//
249Function FitWrapper(folderStr,funcStr,coefStr,useCursors,useEps,useConstr)
250        String folderStr,funcStr,coefStr
251        Variable useCursors,useEps,useConstr
252
253        String suffix=getModelSuffix(coefStr)
254       
255        SetDataFolder $("root:"+folderStr)
256        if(!exists(coefStr))
257                // must be unsmeared model, work in the root folder
258                SetDataFolder root:                             
259                if(!exists(coefStr))            //this should be fine if the coef filter is working, but check anyhow
260                        DoAlert 0,"the coefficient and data sets do not match"
261                        return 0
262                endif
263        endif
264               
265        WAVE cw=$(coefStr)     
266        Wave hold=$("Hold"+suffix)
267        Wave/T lolim=$("LoLim"+suffix)
268        Wave/T hilim=$("HiLim"+suffix)
269        Wave eps=$("epsilon"+suffix)
270       
271// fill a struct instance whether I need one or not
272        String DF="root:"+folderStr+":"
273       
274        Struct ResSmearAAOStruct fs
275        WAVE resW = $(DF+folderStr+"_res")             
276        WAVE fs.resW =  resW
277        WAVE yw=$(DF+folderStr+"_i")
278        WAVE xw=$(DF+folderStr+"_q")
279        WAVE sw=$(DF+folderStr+"_s")
280        Wave fs.coefW = cw
281        Wave fs.yW = yw
282        Wave fs.xW = xw
283       
284        Duplicate/O yw $(DF+"FitYw")
285        WAVE fitYw = $(DF+"FitYw")
286        fitYw = NaN
287       
288        Variable useRes=0
289        if(stringmatch(funcStr, "Smear*"))              // if it's a smeared function, need a struct
290                useRes=1
291        endif
292       
293        Make/O/T/N=0 constr
294        if(useConstr)
295                String constraintExpression
296                Variable i, nPnts=DimSize(lolim, 0),nextRow=0
297                for (i=0; i < nPnts; i += 1)
298                        if (strlen(lolim[i]) > 0)
299                                InsertPoints nextRow, 1, constr
300                                sprintf constraintExpression, "K%d > %s", i, lolim[i]
301                                constr[nextRow] = constraintExpression
302                                nextRow += 1
303                        endif
304                        if (strlen(hilim[i]) > 0)
305                                InsertPoints nextRow, 1, constr
306                                sprintf constraintExpression, "K%d < %s", i, hilim[i]
307                                constr[nextRow] = constraintExpression
308                                nextRow += 1
309                        endif
310                endfor
311        endif
312
313        //if useCursors, and the data is USANS, need to feed a trimmed matrix to the fit
314        if(useCursors && (dimsize(resW,1) > 4) )
315                Variable pt1,pt2,newN
316                if(pcsr(A) > pcsr(B))
317                        pt1 = pcsr(B)
318                        pt2 = pcsr(A)
319                else
320                        pt1 = pcsr(A)
321                        pt2 = pcsr(B)
322                endif
323                newN = pt2 - pt1 + 1            // +1 includes both cursors in the fit
324                Make/O/D/N=(newN,newN) $(DF+"crsrResW")
325                WAVE crsrResW = $(DF+"crsrResW")
326                crsrResW = resW[p+pt1][q+pt1]
327                //assign to the struct
328                WAVE fs.resW =  crsrResW               
329        endif
330////
331
332//don't use the auto-destination with no flag, it doesn't appear to work correctly
333        do
334                if(useRes && useEps && useCursors && useConstr)         //do it all
335                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr /STRC=fs
336                        break
337                endif
338               
339                if(useRes && useEps && useCursors)              //no constr
340                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /E=eps /D=fitYw /STRC=fs
341                        break
342                endif
343               
344                if(useRes && useEps && useConstr)               //no crsr
345                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr /STRC=fs
346                        break
347                endif
348               
349                if(useRes && useCursors && useConstr)           //no eps
350                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw /C=constr /STRC=fs
351                        break
352                endif
353               
354                if(useRes && useCursors)                //no eps, no constr
355                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw /STRC=fs
356                        break
357                endif
358               
359                if(useRes && useEps)            //no crsr, no constr
360                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /STRC=fs
361                        break
362                endif
363       
364                if(useRes && useConstr)         //no crsr, no eps
365                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /C=constr /STRC=fs
366                        break
367                endif
368               
369                if(useRes)              //just res
370                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /STRC=fs
371                        break
372                endif
373               
374/////   same as above, but all without useRes
375                if(useEps && useCursors && useConstr)           //do it all
376                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr
377                        break
378                endif
379               
380                if(useEps && useCursors)                //no constr
381                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /E=eps /D=fitYw
382                        break
383                endif
384               
385                if(useEps && useConstr)         //no crsr
386                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr
387                        break
388                endif
389               
390                if(useCursors && useConstr)             //no eps
391                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw /C=constr
392                        break
393                endif
394               
395                if(useCursors)          //no eps, no constr
396                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw
397                        break
398                endif
399               
400                if(useEps)              //no crsr, no constr
401                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw
402                        break
403                endif
404       
405                if(useConstr)           //no crsr, no eps
406                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /C=constr
407                        break
408                endif
409               
410                //just a plain vanilla fit
411                FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw
412       
413        while(0)
414       
415        // append the fit
416        // need to manage duplicate copies
417        // Don't plot the full curve if cursors were used (set fitYw to NaN on entry...)
418        String traces=TraceNameList("", ";", 1 )
419        if(strsearch(traces,"FitYw",0) == -1)
420                AppendToGraph fitYw vs xw
421        endif
422       
423        DoUpdate                //force update of table and graph with fitted values (why doesn't this work? - the table still does not update)
424       
425        // report the results (to the panel?)
426        print "V_chisq = ",V_chisq
427        print cw
428        WAVE w_sigma
429        print w_sigma
430       
431        SetDataFolder root:
432        return(0)
433End
434
435// parse something off of a table, or ?
436Function/S getHStr(hold)
437        Wave hold
438       
439        String str=""
440        Variable ii
441        for(ii=0;ii<numpnts(hold);ii+=1)
442                str += num2str(hold[ii])
443        endfor
444
445//      print str
446        if(strsearch(str, "1", 0) == -1)
447                return ("")
448        else
449                return(str)
450        endif
451End
452
Note: See TracBrowser for help on using the repository browser.