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

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

Added the test version of the new fit wrapper panel to the branch and #included Wrapper.ipf in includes_v300
The panel still must be opened by typing WrapperPanel?() at the command line

File size: 11.9 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)
314//              Print "pcsr(A) = ",pcsr(A)
315//              Print "pcsr(B) = ",pcsr(B)
316//      endif
317////
318
319//don't use the auto-destination with no flag, it doesn't appear to work correctly
320        do
321                if(useRes && useEps && useCursors && useConstr)         //do it all
322                        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
323                        break
324                endif
325               
326                if(useRes && useEps && useCursors)              //no constr
327                        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
328                        break
329                endif
330               
331                if(useRes && useEps && useConstr)               //no crsr
332                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr /STRC=fs
333                        break
334                endif
335               
336                if(useRes && useCursors && useConstr)           //no eps
337                        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
338                        break
339                endif
340               
341                if(useRes && useCursors)                //no eps, no constr
342                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw /STRC=fs
343                        break
344                endif
345               
346                if(useRes && useEps)            //no crsr, no constr
347                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /STRC=fs
348                        break
349                endif
350       
351                if(useRes && useConstr)         //no crsr, no eps
352                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /C=constr /STRC=fs
353                        break
354                endif
355               
356                if(useRes)              //just res
357                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /STRC=fs
358                        break
359                endif
360               
361/////   same as above, but all without useRes
362                if(useEps && useCursors && useConstr)           //do it all
363                        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
364                        break
365                endif
366               
367                if(useEps && useCursors)                //no constr
368                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /E=eps /D=fitYw
369                        break
370                endif
371               
372                if(useEps && useConstr)         //no crsr
373                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw /C=constr
374                        break
375                endif
376               
377                if(useCursors && useConstr)             //no eps
378                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw /C=constr
379                        break
380                endif
381               
382                if(useCursors)          //no eps, no constr
383                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw[pcsr(A),pcsr(B)] /X=xw /W=sw /I=1 /D=fitYw
384                        break
385                endif
386               
387                if(useEps)              //no crsr, no constr
388                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /E=eps /D=fitYw
389                        break
390                endif
391       
392                if(useConstr)           //no crsr, no eps
393                        FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw /C=constr
394                        break
395                endif
396               
397                //just a plain vanilla fit
398                FuncFit/H=getHStr(hold) /NTHR=0 $funcStr cw, yw /X=xw /W=sw /I=1 /D=fitYw
399       
400        while(0)
401       
402        // append the fit
403        // need to manage duplicate copies
404        // Don't plot the full curve if cursors were used (set fitYw to NaN on entry...)
405        String traces=TraceNameList("", ";", 1 )
406        if(strsearch(traces,"FitYw",0) == -1)
407                AppendToGraph fitYw vs xw
408        endif
409       
410        DoUpdate                //force update of table and graph with fitted values (why doesn't this work? - the table still does not update)
411       
412        // report the results (to the panel?)
413        print "V_chisq = ",V_chisq
414        print cw
415        WAVE w_sigma
416        print w_sigma
417       
418        SetDataFolder root:
419        return(0)
420End
421
422// parse something off of a table, or ?
423Function/S getHStr(hold)
424        Wave hold
425       
426        String str=""
427        Variable ii
428        for(ii=0;ii<numpnts(hold);ii+=1)
429                str += num2str(hold[ii])
430        endfor
431
432//      print str
433        if(strsearch(str, "1", 0) == -1)
434                return ("")
435        else
436                return(str)
437        endif
438End
439
Note: See TracBrowser for help on using the repository browser.