{VERSION 6 0 "IBM INTEL NT" "6.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "2D Output" -1 20 "Times" 1 12 0 0 255 1 0 0 0 2 2 1 0 0 0 1 }{CSTYLE "ParagraphStyle3" -1 256 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "ParagraphStyle2" -1 257 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "ParagraphStyle1" -1 258 "Times " 1 12 0 0 255 1 0 0 0 2 2 1 0 0 0 1 }{CSTYLE "2D Math Symbol 2" -1 259 "Symbol" 0 1 0 0 0 0 2 2 2 2 2 2 0 0 0 1 }{CSTYLE "_cstyle59" -1 260 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle58" -1 261 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle5 7" -1 262 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_csty le56" -1 263 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cst yle55" -1 264 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_ cstyle54" -1 265 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 } {CSTYLE "_cstyle53" -1 266 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle52" -1 267 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle51" -1 268 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle50" -1 269 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle49" -1 270 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle48" -1 271 "Courier" 1 12 255 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle47" -1 272 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle46" -1 273 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle45" -1 274 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle44" -1 275 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle43" -1 276 "Courier " 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle42" -1 277 "Cour ier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle41" -1 278 "T imes" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle40" -1 279 " Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle66" -1 280 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle67" -1 281 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{CSTYLE "_cstyle6 8" -1 282 "Times" 1 12 0 0 255 1 0 0 0 2 2 2 0 0 0 1 }{CSTYLE "_cstyle 69" -1 283 "Courier" 1 12 255 0 0 1 0 1 0 2 1 2 0 0 0 1 }{PSTYLE "Norm al" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 } 1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "Line Printed Output" -1 6 1 {CSTYLE "" -1 -1 "Courier" 1 12 0 0 255 1 2 2 2 2 2 1 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "Maple Output" -1 12 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle 70" -1 256 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle9" -1 257 1 {CSTYLE " " -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle8" -1 258 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE " _pstyle7" -1 259 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle6" -1 260 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle5" -1 261 1 {CSTYLE "" -1 -1 "Times " 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle4" -1 262 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle69" -1 263 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle3" -1 264 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle68" -1 265 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle2 " -1 266 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 255 1 2 2 2 2 2 1 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle67" -1 267 1 {CSTYLE " " -1 -1 "Courier" 1 12 255 0 255 1 2 2 2 2 2 1 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle1" -1 268 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle66" -1 269 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle65" -1 270 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle64" -1 271 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle63" -1 272 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_psty le62" -1 273 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle61" -1 274 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle60" -1 275 1 {CSTYLE "" -1 -1 "Time s" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle59" -1 276 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle58" -1 277 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle57" -1 278 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle56" -1 279 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle55 " -1 280 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 } 1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle54" -1 281 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle53" -1 282 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle 52" -1 283 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle51" -1 284 1 {CSTYLE " " -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle50" -1 285 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_psty le49" -1 286 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle48" -1 287 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle47" -1 288 1 {CSTYLE "" -1 -1 " Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle46" -1 289 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle45" -1 290 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle44" -1 291 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle43" -1 292 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle42 " -1 293 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 } 3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle41" -1 294 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle40" -1 295 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle 39" -1 296 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle38" -1 297 1 {CSTYLE " " -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle37" -1 298 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_psty le36" -1 299 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle35" -1 300 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle34" -1 301 1 {CSTYLE "" -1 -1 "Cour ier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle33" -1 302 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle32" -1 303 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle31" -1 304 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle30" -1 305 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle13 3" -1 306 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle132" -1 307 1 {CSTYLE " " -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle131" -1 308 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_ps tyle130" -1 309 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle29" -1 310 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle28" -1 311 1 {CSTYLE "" -1 -1 "Time s" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle27" -1 312 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle26" -1 313 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle129" -1 314 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle25" -1 315 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle 128" -1 316 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle24" -1 317 1 {CSTYLE " " -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle127" -1 318 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_ps tyle23" -1 319 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle126" -1 320 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle22" -1 321 1 {CSTYLE "" -1 -1 "Time s" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle125" -1 322 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle21" -1 323 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle20" -1 324 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle124" -1 325 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle 123" -1 326 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle122" -1 327 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle121" -1 328 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE " _pstyle120" -1 329 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle19" -1 330 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle18" -1 331 1 {CSTYLE "" -1 -1 "Time s" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle17" -1 332 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle134" -1 333 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle135" -1 334 1 {CSTYLE "" -1 -1 "Courier" 1 12 255 0 0 1 2 1 2 2 1 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle136" -1 335 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE " _pstyle137" -1 336 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle138" -1 337 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle139" -1 338 1 {CSTYLE "" -1 -1 "Tim es" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle140" -1 339 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle141" -1 340 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle142" -1 341 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle143" -1 342 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_psty le144" -1 343 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle145" -1 344 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle146" -1 345 1 {CSTYLE "" -1 -1 "Tim es" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 } {PSTYLE "_pstyle147" -1 346 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 2 0 2 0 2 2 0 1 }{PSTYLE "_pstyle148" -1 347 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }} {SECT 0 {EXCHG {PARA 333 "> " 0 "" {MPLTEXT 1 280 3467 "#\n# This is t he source code file of the \"SchurFkt\" package\n# SchurFkt Version 1. 0.2 (9 vi 2008) file SchurFkt-code-ver.1.0.2-9vi08_M11.mws\n# date: \+ June 19, 2008\n#\n# copyright (c) Bertfried Fauser, & Rafal Ablamowicz \n# 2003-2008, all rights reserved.\n#\n################ #############################################################\n# \+ # \n# DISCLAIMER: \+ #\n# \+ #\n# THERE IS NO WARRANTY FOR THE SCHURFKT PACKAGE T O THE EXTENT PERMITTED #\n# BY APPLICABLE LAW. EXCEPT WHEN OTHERWI SE STATED IN WRITING THE COPYRIGHT #\n# HOLDERS AND/OR OTHER PARTIES \+ PROVIDE THE PROGRAM \"AS IS\" WITHOUT #\n# WARRANTY OF ANY KI ND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT #\n# LIMITED T O, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR #\n# \+ A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANC E #\n# OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIV E, YOU #\n# ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR O R CORRECTION. #\n# \+ #\n##################################### ########################################\n#\n# If you want to use thi s code or parts of it under a GPL LICENCE, please\n# contact the auth ors:\n# rablamowicz tntech.edu or \n# Bertfried .Fauser uni-konstanz.de\n#\n#\n# +++ The package computes some pr oducts and coproducts for Schur functions\n# --- \n# --- Remember: ele mentary symmetric functions are s[1^r] \n# --- complete symm etric functions are s[r]\n#\n# +++ Main functions are:\n# --- outer \+ : the outer product of Schur functions outer(s[3,2],s[1],...)\n# -- - inner : the inner product of Schur functions inner(s[2,2],s[3,1 ],...)\n# --- skew : the (outer) skew product of two Schur funct ions skew(s[3,2,1],s[2])\n# --- couter : the outer coproduct of a \+ Schur function couter(s[4,2])\n# --- cinner : the inner coproduct \+ of a Schur function cinner(s[4,2,2])\n# --- antipS : the antipode \+ of a Schur function AntipS(s[lambda])= (-1)^|lambda|*s[lambda']\n# \+ w.r.t. the outer(!) Hopf algebra\n#\n# --- KostkaTable: \+ computes the Kostka matrix of rank n\n# --- isLattice : returns true \+ is a Young tableau filled with letters (0) 1..n is a \n# \+ lattice permutation\n# the tableau has to be give n as [[row1 list ,...],[row2 list, ...],...] \n# (mai nly internal use)\n#\n# +++ TYPES:\n# Are exposed globally t o Maple via the init routine of the package, any\n# new basi s requires an own type. Later versions of Schur may allow the user to \+ create \n# own types!\n#\n# --- s-functions come in monoms, \+ terms and polynoms\n# --- m-functions come in monoms, terms and polyno ms\n# --- p-functions come in monoms, terms and polynoms\n# --- e-func tions come in monoms, terms and polynoms\n# --- h-functions come in mo noms, terms and polynoms\n# --- f-functions come in monoms, terms and \+ polynoms\n# \n# There is a need to introduce orthogonal and symple ctic Schur functions and other bases\n# currently these are dealt \+ with using the _same_ names but _different_ algebraic maps!!\n#\n# === > some symmetric function bases and or operations in several bases are not yet available \n#" }}{PARA 334 "> " 0 "" {MPLTEXT 1 0 9 "restart: \n" }{MPLTEXT 1 281 86964 "SchurFkt:=module()\n export MLIN,FLAT,isL attice,\n concatM,LaplaceM,LaplaceM_mon,LaplaceTable,\n \+ outer,outerS,outerM,outerH,outerE,outerP,\n skew,\n \+ couter,couterM,couterH,couterE,couterP,\n antipS,antipP,a ntipH,antipE,antipM,antipMC,\n KostkaTable,KostkaPC,Scalar,Sc alarP,ScalarMH,ScalarHM,\n AlexComp,grAlexComp,PartNM,CompNM, zee,truncWT,truncLEN,\n part2mset,mset2part,conjpart,cmp2prtM ult,cmp2part,Frob2part,part2Frob,\n MurNak,MurNak2,CharHook,s q_coeff,\n dimSN,GesselThetaP,GesselThetaS,\n inner, innerP,innerH,\n cinner,counitInnerS,cinnerP,counitInnerP,\n \+ plethP,cplethP,plethS,plethSnm,cplethS,\n p_to_m,m_t o_p,s_to_p,p_to_s,x_to_s,s_to_x,s_to_h,s_to_hJT,h_to_s,h_to_m,\n \+ e_to_h,e_to_s,\n s_to_hmat,evalJacobiTrudiMatrix,maxlengt hSymFkt,\n outerON,couterON,getSfktSeries,branch;\n global \+ `type/hfktmonom`, `type/hfktterm`, `type/hfktpolynom`,\n `typ e/efktmonom`, `type/efktterm`, `type/efktpolynom`,\n `type/sf ktmonom`, `type/sfktterm`, `type/sfktpolynom`,\n `type/pfktmo nom`, `type/pfktterm`, `type/pfktpolynom`,\n `type/ffktmonom` , `type/ffktterm`, `type/ffktpolynom`,\n `type/mfktmonom`, `t ype/mfktterm`, `type/mfktpolynom`,\n `type/symfktmonom`, `typ e/symfktterm`, `type/symfktpolynom`;\n local init,exit,ADD,LRR,getPa rt,makeRimRep,removeRimHook,MurNakRim,\n dimSN_mon,\n \+ LaplaceMset,concatM_mon,concat_mon,\n inner_mon,cinner_mon,inn erP_mon,cinnerP_mon,innerH_mon,\n couterM_mon,couterH_mon,cout erE_mon,couterP_mon,\n antipS_mon,antipP_mon,antipH_mon,antipE _mon,antipM_mon,antipMC_mon,\n p_to_mM,m_to_pM,\n list _divisors,truncLEN_mon,GesselThetaP_mon,GesselThetaS_mon,\n pl ethPsingleP,x_to_sM,s_to_xM,s_to_hM,h_to_sM,h_to_mM,\n etoh,e_ to_hM,e_to_sM,\n plethP_mon,plethsp,plethSP,plethS_mon,cplethS _mon,\n sfktmon_to_hmatrix,\n outerON_monom,couterON_m onom,branch_monom; \n option package,\n load=init,\n \+ unload=exit;\n#\n#\n#\ninit:=proc()\n global FIELD,`type/cliscala r`;\n#\n#\n#\nprintf(\"SchurFkt Version 1.0.2 (9 vi 2008) at your serv ice\\n(c) 2003-2008 BF&RA, no warranty, no fitness for anything!\\n\", %s);\n#\n# set the global variable FIELD to specify the ground field o f the ring /\\ and sepcify the\n# linearity of the tensor product \+ &t in use\n#\n#\nFIELD:=\{'integer','fraction'\}:\nif assigned(`&t`) t hen unassign(`&t`) end if;\n`type/cliscalar`:=proc(x) type(x,FIELD) en d proc:\ndefine(`&t`,multilinear,flat,domain=FIELD);\n#\n# type: SYM -Fkt (general symmetric function type)\n#\n `type/symfktmonom`:=proc( a)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. Al l rights reserved.`; \n member(op(0,a),\{s,p,h,m,e,f\});\n end p roc:\n#\n `type/symfktterm`:=proc(a)\n option `Copyright (c) B. F auser & R. Ablamowicz 2003-2008. All rights reserved.`; \n if typ e(a,`symfktmonom`) then return true fi; \n if type(a,`*`) and 1<>s elect(type,a,`ssymfktmonom`) then\n true;\n else\n fal se; \n fi;\n end proc:\n#\n `type/symfktpolynom`:=proc(a) \n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n if type(a,`symfktterm`) then return true fi:\n \+ if type(a,`+`) then \n return evalb(map(type,\{op(a)\},symfktt erm)=\{true\})\n else\n return false;\n fi\n end proc: \n#\n# type: S-Fkt\{monom,term,polynom\}\n#\n `type/sfktmonom`:=pro c(a)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. \+ All rights reserved.`; \n evalb(`s`=op(0,a));\n end proc:\n#\n \+ `type/sfktterm`:=proc(a)\n option `Copyright (c) B. Fauser & R. Ab lamowicz 2003-2008. All rights reserved.`; \n if type(a,`sfktmono m`) then return true fi; \n if type(a,`*`) and 1<>select(type,a,`s fktmonom`) then\n true;\n else\n false; \n fi;\n \+ end proc:\n#\n `type/sfktpolynom`:=proc(a) \n option `Copyright ( c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n \+ if type(a,`sfktterm`) then return true fi:\n if type(a,`+`) then \+ \n return evalb(map(type,\{op(a)\},sfktterm)=\{true\})\n els e\n return false;\n fi\n end proc:\n#\n# type: p-Fkt\{mon om,term,polynom\}\n#\n `type/pfktmonom`:=proc(a)\n option `Copyri ght (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \+ \n evalb(`p`=op(0,a));\n end proc:\n#\n `type/pfktterm`:=proc(a) \n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All \+ rights reserved.`; \n if type(a,`pfktmonom`) then return true fi; \n if type(a,`*`) and 1<>select(type,a,`pfktmonom`) then\n \+ true;\n else\n false; \n fi;\n end proc:\n#\n `type/pf ktpolynom`:=proc(a) \n option `Copyright (c) B. Fauser & R. Ablamo wicz 2003-2008. All rights reserved.`; \n if type(a,`pfktterm`) t hen return true fi:\n if type(a,`+`) then \n return evalb(ma p(type,\{op(a)\},pfktterm)=\{true\})\n else\n return false; \n fi\n end proc:\n#\n# type: m-Fkt\{monom,term,polynom\}\n#\n \+ `type/mfktmonom`:=proc(a)\n option `Copyright (c) B. Fauser & R. \+ Ablamowicz 2003-2008. All rights reserved.`; \n evalb(`m`=op(0,a) );\n end proc:\n#\n `type/mfktterm`:=proc(a)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n \+ if type(a,`mfktmonom`) then return true fi; \n if type(a,`*`) a nd 1<>select(type,a,`mfktmonom`) then\n true;\n else\n \+ false; \n fi;\n end proc:\n#\n `type/mfktpolynom`:=proc(a) \n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All righ ts reserved.`; \n if type(a,`mfktterm`) then return true fi:\n \+ if type(a,`+`) then \n return evalb(map(type,\{op(a)\},mfktter m)=\{true\})\n else\n return false;\n fi\n end proc:\n# \n# type: h-Fkt\{monom,term,polynom\}\n#\n `type/hfktmonom`:=proc(a )\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n evalb(`h`=op(0,a));\n end proc:\n#\n `ty pe/hfktterm`:=proc(a)\n option `Copyright (c) B. Fauser & R. Ablam owicz 2003-2008. All rights reserved.`; \n if type(a,`hfktmonom`) then return true fi; \n if type(a,`*`) and 1<>select(type,a,`hfkt monom`) then\n true;\n else\n false; \n fi;\n end proc:\n#\n `type/hfktpolynom`:=proc(a) \n option `Copyright (c) \+ B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n if type(a,`hfktterm`) then return true fi:\n if type(a,`+`) then \n \+ return evalb(map(type,\{op(a)\},hfktterm)=\{true\})\n else\n return false;\n fi\n end proc:\n#\n# type: e-Fkt\{monom, term,polynom\}\n#\n `type/efktmonom`:=proc(a)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n \+ evalb(`e`=op(0,a));\n end proc:\n#\n `type/efktterm`:=proc(a)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All righ ts reserved.`; \n if type(a,`efktmonom`) then return true fi; \n \+ if type(a,`*`) and 1<>select(type,a,`efktmonom`) then\n true ;\n else\n false; \n fi;\n end proc:\n#\n `type/efktpo lynom`:=proc(a) \n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n if type(a,`efktterm`) then \+ return true fi:\n if type(a,`+`) then \n return evalb(map(ty pe,\{op(a)\},efktterm)=\{true\})\n else\n return false;\n \+ fi\n end proc:\n#\n#\n# type: f-Fkt\{monom,term,polynom\}\n#\n ` type/ffktmonom`:=proc(a)\n option `Copyright (c) B. Fauser & R. Ab lamowicz 2003-2008. All rights reserved.`; \n evalb(`f`=op(0,a)); \n end proc:\n#\n `type/ffktterm`:=proc(a)\n option `Copyright ( c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n \+ if type(a,`ffktmonom`) then return true fi; \n if type(a,`*`) and 1<>select(type,a,`ffktmonom`) then\n true;\n else\n f alse; \n fi;\n end proc:\n#\n `type/ffktpolynom`:=proc(a) \n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n if type(a,`ffktterm`) then return true fi:\n \+ if type(a,`+`) then \n return evalb(map(type,\{op(a)\},ffktterm) =\{true\})\n else\n return false;\n fi\n end proc:\n#\n #\nend proc: # init \n#\n#\n#\nexit:=proc()\n option `Copyright (c) B . Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n printf (\"SchurFkt Version 1.0.2 says 'Good bye...'\\n\",%s);\nend proc:\n### #######################\n#\n# Helper functions\n#\n################### #######\n#\n# MLIN is a function which allows to make a procedure mult ilinear w.r.t. the integers\n# or any ground field specified in t he global variable FIELD\n# Mostly internal use!\n# +++ (warning \+ may be replaced in future releases, don't use it in own code!)\n#\nMLI N:=proc()\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008 . All rights reserved.`; \n local i,P,pt,res,sg;\n for i from 1 to \+ nargs do\n lst||i:=args[i];\n if type(lst||i,`+`) then lst||i:=[ op(lst||i)] else lst||i:=[lst||i] end if;\n end do:\n sg:=proc(x)\n \+ local cf,tm;\n if type(x,integer) then \n return sign(x) \n elif type(x,`*`) then \n cf,tm:=selectremove(type,x,integer); \n return cf; \n else \n return 1 \n end if; \n end p roc:\n res:=0:\n P:=combinat[cartprod]([seq(lst||i,i=1..nargs)]):\n \+ while not P[finished] do \n pt:=P[nextvalue]();\n res:=res+mul( sg(pt[i]),i=1..nops(pt))*T(seq(pt[i]/sg(pt[i]),i=1..nops(pt)));\n end do;\n res;\nend proc:\n#\n# FLAT is a function which allows to impos e the associativity of functions \n# (flaten expressions) Mostly \+ internal use.\n# +++ (warning may be replaced in future releases, don' t use it in own code!)\n#\nFLAT:=proc()\n option `Copyright (c) B. Fa user & R. Ablamowicz 2003-2008. All rights reserved.`; \n local x,ls t,drp,cf,term;\n x:=eval(subs(T=MLIN,args));\n drp:=proc() args end \+ proc:\n if type(x,`+`) then \n return eval(subs(T=MLIN,map(procnam e,x)))\n elif type(x,`*`) then \n cf,term:=selectremove(type,x,'in teger');\n return cf*eval(subs(T=MLIN,T(eval(subs(T=drp,term))))); \n else\n return eval(subs(T=MLIN,T(eval(subs(T=drp,x)))));\n end if;\nend proc:\n#\n#\n#\n##########################\n#\n# Combinatori al functions\n#\n##########################\n#\n# KostkaPC computes th e Kostka coefficient between a partition and a composition.\n# \+ Every composition lies in a symmetric group orbit of a particular \n # partition, on which the Kostka coefficient is actually cons tant.\n# KostkaPC is defined as the Schur-Hall scalar product of the h[comp[i]]\n# (=s[comp[i]) and the Schur function wit h partition part. Since the outer\n# product is commutative a nd since zero parts of the composition turn into\n# the multi plicative unit, we compute just the outer product of the one\n# \+ part Schurfunctions and then the scalar product. \n#\nKostkaPC:=pro c(part1,part2)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003 -2008. All rights reserved.`;\n local mks;\n mks:=(lst)->map(i->s[op (i)],lst);\n subs(s[0]=1,\n Scalar(outer(op(map(i->mks(i),part2) )),s[op(part1)])\n );\nend proc:\n#\n# grAlexcomp establishes the graded (by parts) anti lexicographical ordering on integer \n# \+ partitions or compositions.\n#\ngrAlexComp:=proc(x,y)\n option ` Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved .`; \n if nops(x)y[i] then return true elif x[i]if x=0 then NULL else x end if,[seq(op(tbl[cl+1-i]),i=1..cl)]); \n nl:=max(op(lst));\n for i from 1 to nl do\n T[i]:=0:\n end do :\n for i from nops(lst) by -1 to 1 do\n T[lst[i]]:=T[lst[i]]+1;\n if member(false,\{seq(evalb(T[i]>=T[i+1]),i=1..nl-1)\}) then \n \+ return false;\n end if;\n end do;\n true; \nend proc:\n#\n# AD D (internal use) adds a single letter named 'let' (integer) to a table au in such\n# a way, that the resulting word is a lattice permutat ion (i.e. in a way which is\n# allowed by the Littlewood Richardso n rule). This is the function which actually\n# implements the Lit tlewood Richardson rule. It tries to be clever about summation\n# \+ but might be greatly improved on speed still, but used option remember .\n# \nADD:=proc(tbl,let)\n option `Copyright (c) B. Fauser & R. \+ Ablamowicz 2003-2008. All rights reserved.`\n ,remember;\n lo cal cl,rl,ad,min,res,i;\n#####\n# +++ preliminary stuff\n cl:=nops(tb l); rl:=map(x->nops(x),tbl);\n ad:=(x,y)->[op(x),y]:\n res:=[]:\n# - -- \n#####\n# +++ find first row with letter 'let'\n# --- descending \+ search\n min:=cl+1:\n if member(let,\{op(map(x->op(x),tbl))\}) then \n for i from cl by -1 to 1 do\n if member(let,\{op(tbl[i])\}) then min:=i: break; end if;\n end do:\n else # -- no let 'let'\n \+ min:=1;\n end if;\n#####\n# +++ find first row with more letters l et-1 than letters 'let'\n# +++ but start at row 'min'\n# --- ascending search\n if let>1 then \n for i from max(1,min-1) to cl do\n \+ if `+`(op( map(x->op(x),[seq( map( x->if x=let-1 then -1 elif x=let t hen 1 else NULL end if,\n tbl[k]), k=1..i)]) )) \+ < 0 then min:=i+1: break; \n end if;\n end do:\n end if;\n### ## \n #\n # +++ now start to put the letter in any possible place\n \+ # --- beginning with row 'min'\n #\n for i from min to cl do\n #\n # +++ case i=1 is different\n #\n if i=1 then \n if (tbl[i] [-1]<=let or tbl[i][-1]=0) then \n if isLattice(subsop(i=ad(tb l[i],let),tbl)) then \n res:=[op(res),subsop(i=ad(tbl[i],let) ,tbl)];\n end if; \n end if;\n else\n # +++ cases i=2. .cl\n if (rl[i-1]>rl[i]) then \n if (tbl[i][-1]<=let or tb l[i][-1]=0) then\n if (tbl[i-1][rl[i]+1]s[op(x)],[seq(map(x->nops(x),TT[k]),k=1..nops(TT))]))); \nend proc: \n#\n# getPart strips of the name of a symmetric function n[a,b,c] ret urning the indexing list.\n# +++ no longer used, inline use in cod e as [op(x)] directly. \ngetPart:=proc(x)\n option `Copyright (c) B. \+ Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n [op(x)]; \nend proc:\n#\n# PartNM returns a list of partitions of N with M part s.\n# PartNM returns a list ordered inversely to teh standard M aple\n# combinat package! \n#\nPartNM := proc(n, m)\n option ` Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved .`,\n remember;\n local i, p, s, t;\n if n = 0 then\n ret urn [[]]\n elif m = 1 then\n return [[`$`(1,n)]]\n else\n for \+ i to m do\n t := procname(n-i,min(n-i,i));\n p[i] := seq([i, op(s)],s = t)\n end do;\n [seq](p[m+1-i],i = 1 .. m);\n end if ;\nend proc:\n#\n# CompNM returns a list of compositions of N with M p arts\n#\nCompNM:=proc(N,M)\n option `Copyright (c) B. Fauser & R. Ab lamowicz 2003-2008. All rights reserved.`,\n remember;\n lo cal res,i;\n if M<1 then return [] end if;\n if M=1 then return [N ] end if;\n if M=2 then return [seq([N-i,i],i=0..N)] end if;\n res :=[];\n for i from N to 0 by -1 do\n res:=[op(res),op(map(x->[i, op(x)],procname(N-i,M-1)))];\n end do;\n res;\nend proc:\n#\n# par t2mset transforms a partition into multiset format, that is a composit ion\n# which gives the multiplicities of parts [4,4,2,1,1] - > [2,1,0,2]\n#\npart2mset:=proc(part)\n option `Copyright (c) B. Faus er & R. Ablamowicz 2003-2008. All rights reserved.`,\n rememb er;\n local m,mset,i;\n if part=[0] then return [] end if;\n m:=max (op(part));\n mset:=[seq(0,i=1..m)];\n for i from 1 to nops(part) do \n mset[part[i]]:=mset[part[i]]+1;\n end do;\n mset; \nend proc: \n#\n# mset2part transforms a partition inmulti set representation int o an ordinary partition\n# represented by nonnegative intege r parts\n#\nmset2part:=proc(mset)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember; \n local prt,i;\n prt:=[];\n for i from 1 to nops(mset) do\n prt :=[i$mset[i],op(prt)]\n end do;\n if prt=[] then return [0] end if; \n prt;\nend proc:\n#\n# conjpart gives the conjugated partition of t he partition part\n#\nconjpart:=proc(part)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`\n ,re member;\n local len,res,ppart;\n if part=[] or part=[0] then return \+ [0] end if;\n len:=nops(part);\n ppart:=part;\n res:=[];\n while p part<>[] do\n res:=[op(res),len$ppart[-1]];\n ppart:=map(x->if x =ppart[-1] then NULL else x-ppart[-1] end if,ppart);\n len:=nops(pp art);\n end do;\n res;\nend proc:\n#\n# zee gives the factor z in th e schur scalar product of power sums.\n#\n#\nzee:=proc(part)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserv ed.`\n ,remember;\n local mset;\n mset:=part2mset(part);\n \+ mul(i^mset[i]*mset[i]!,i=1..nops(mset));\nend proc:\n#\n# cmp2prtMult gives the multiplicity of the orbit of a composition\n# \+ of its associated partition under the S_n\n#\ncmp2prtMult:=proc(comp) \n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rig hts reserved.`,\n remember;\n local nc,part,f,cnt0;\n nc:=n ops(comp);\n cnt0:=0;\n part:=map(x->if x=0 then cnt0:=cnt0+1; NULL \+ else x end if,\n sort(comp,(i,j)->if i>=j then true else fa lse end if) );\n part:=map(x->if x=0 then NULL else x end if,part2mse t(part));\n if cnt0=0 then part:=part[1..-2] end if;\n ############# ####\n f:=(ri,N)->mul(N-k,k=0..ri-1)/ri!;\n #################\n mul (f(part[k],nc+part[1]-add(part[m],m=1..k)),k=1..nops(part));\nend proc :\n#\n# cmp2part takes a composition and transforms it into a partitio n.\n# This is a projection and a 'base point projection'.\n# \ncmp2part:=proc(comp)\n option `Copyright (c) B. Fauser & R. Ablamo wicz 2003-2008. All rights reserved.`,\n remember;\n map(x- >if x=0 then NULL else x end if,\n sort(comp,(i,j)->if i>=j then tru e else false end if) );\nend proc:\n#\n# part2Frob maps a partition in to Frobenius notation.\n# _internal use_\n#\npart2Frob:=proc (Part)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. A ll rights reserved.`,\n remember;\n local res,part;\n if Pa rt=[0] or Part=[] then return [[],[]] end if;\n part,res:=Part,[[],[] ];\n while part<>[] do\n res[1]:=[op(res[1]),part[1]-1];\n res[ 2]:=[op(res[2]),nops(part)-1];\n part:=map(x->if x>1 then x-1 else \+ NULL end if,part[2..-1]);\n end do;\n res;\nend proc:\n#\n# Frob2par t maps a partition in Frobenius notation into a standard partition\n# \+ _internal use_\n#\nFrob2part:=proc(LList)\n option `Copyrig ht (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local res,llist,row;\n if LList=[[],[]] then ret urn [0] end if;\n res:=[LList[1][-1]+1,1$LList[2][-1]];\n if nops(LL ist[1])=1 then return res end if;\n llist:=[LList[1][1..-2],LList[2][ 1..-2]];\n while llist<>[[],[]] do\n row:=[1$llist[2][-1]];\n \+ res:=[llist[1][-1]+1,op(zip((i,j)->i+j,row,res,0))];\n llist:=[ll ist[1][1..-2],llist[2][1..-2]]; \n end do;\n res;\nend proc:\n##### ###################################################################### ########\n#\n# T R U N C functions\n#\n############################### ####################################################\n#\n# truncWT tru ncates the input to partitions of weight less or equal to the seond ar gument N\n#\ntruncWT:=proc(x,N)\n option `Copyright (c) B. Fauser & R . Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local c f,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n return map(procnam e,x,N);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,symf ktmonom);\n return cf*procname(tm,N)\n else\n if `+`(op(x))>N t hen return 0 else return x end if;\n end if;\nend proc:\n#\n# truncLE N_mon truncates partitions of any type of symmetric function monoms\n# to length less or equal to L\n#\ntruncLEN_mon:=proc(sfkt,L)\n \+ if nops([op(sfkt)])<=L then\n return sfkt\n else\n return 0 \n end if;\nend proc:\n#\n# truncLEN truncates the partitions of a s ymmetric function polynom\n# to length smaller or euqlt to L, it is alinear function\n#\n#\ntruncLEN:=proc(symfkt,L)\n local cf,term; \n if type(symfkt,symfktmonom) then\n truncLEN_mon(symfkt,L)\n el if type(symfkt,`*`) then\n term,cf:=selectremove(type,symfkt,symfkt monom);\n return cf*truncLEN_mon(term,L);\n else\n map(procname ,symfkt,L);\n end if;\nend proc:\n#\n################################ #################################\n#\n# basis transformations\n#\n#### #############################################################\n#\n# s_ to_xM transforms an S-function into a polynom of x-monomials in\n# \+ N variables (x1,x2,...,xn) (N should be greater or equal\n# \+ to the weight of the partition.\n#\n# \n#\ns_to_xM:=proc(sfkt,N)\n option `Co pyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.` \n ,remember;\n local cmp;\n cmp:=CompNM(`+`(op(sfkt)),N);\n add(KostkaPC([op(sfkt)],k)*x[op(k)],k=cmp);\nend proc:\n#\n# x_to_sM gets a monomial and transforms it back into an S-function.\n# \+ This transformation is critical, since the transformation matrix\n# \+ K is rectangular! The inverse is computes on the maximal rank\n # subspace, and suitably normalized, so that the collextion of \n# *all* x monomials which give rise to the same S-functions \n# adds up to the integral result\n#\n# \n#\nx_to_sM:=proc(xfkt)\n opti on `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights rese rved.`\n ,remember;\n local wgt,prt,KMat,tab,tabc,cmp,matT;\n wgt:=`+`(op(xfkt));\n prt:=PartNM(wgt,wgt);\n KMat :=evalm(linalg[ matrix](nops(prt),nops(prt),(i,j)->KostkaPC(prt[i],prt[j]))^(-1));\n \+ tab:=table([seq((prt[k])=k,k=1..nops(prt))]);\n cmp:=CompNM(wgt,nops( [op(xfkt)]));\n matT:=linalg[matrix](nops(cmp),nops(prt),\n (i, j)->1/cmp2prtMult(cmp[i])*KMat[tab[cmp2part(cmp[i])],tab[prt[j]]]);\n \+ ## new index \n tabc:=1; while [op(xfkt)]<>cmp[tabc] do tabc:=tabc+ 1; end do;\n add(matT[tabc,k]*s[op(prt[k])],k=1..nops(prt));\nend pro c:\n#\n# s_to_x linear version of the transformation of S functions to x monomials\n#\ns_to_x:=proc(sfkt,weight)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n r emember;\n local cf,term,lst;\n if sfkt=0 then \n return 0;\n el if type(sfkt,`+`) then \n return map(procname,sfkt,weight)\n elif \+ type(sfkt,`*`) then\n term,cf:=selectremove(type,sfkt,sfktmonom);\n return cf*procname(term,weight)\n else\n s_to_xM(sfkt,weight); \n end if; \nend proc:\n#\n# x_to_s linear version of the transformat ion of x monomials to S functions\n#\nx_to_s:=proc(xfkt)\n option `Co pyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.` ,\n remember;\n local cf,term,lst;\n if type(xfkt,`+`) then \n return map(procname,xfkt)\n elif type(xfkt,`*`) then\n cf,t erm:=selectremove(type,xfkt,\{'integer','fraction'\});\n return cf* procname(term)\n else\n x_to_sM(xfkt);\n end if; \nend proc:\n### ###################################################################### ######\n#\n# h_to_s transformes a complete symmetric function into an \+ s-function polynomial.\n# \nh_to_sM:=proc(hfkt)\n option `Copy right (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`, \n remember;\n if hfkt=0 then return 0 end if;\n outer(op(m ap(i->s[i],[op(hfkt)])));\nend proc:\nh_to_s:=proc(hfkt)\n option `Co pyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.` ;\n local n1,prt,cf,term,lst;\n if hfkt=0 then return 0 end if;\n i f not type(hfkt,hfktpolynom) then \n error(\"wrong basis as input, need complete symmetric functions\"); \n end if;\n if hfkt=h[0] the n return s[0] end if;\n if type(hfkt,`+`) then \n return map(procn ame,hfkt)\n elif type(hfkt,`*`) then\n term,cf:=selectremove(type, hfkt,hfktmonom);\n return cf*procname(term)\n else\n return h_t o_sM(hfkt)\n end if; \nend proc:\n################################### ############################################\n#\n# s_to_h transformes \+ a s-function polynomial into complete symmetric functions.\n#\n# WARNI NG: SLOW!! Uses the inverse Kostka Matrix\n# better use the J acobi-Trudi formula!\n# \ns_to_hM:=proc(sfkt)\n option `Copyri ght (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local prt,N,KI,i;\n KI:=evalm(rhs(KostkaTable(` +`(op(sfkt))))^(-1));\n N:=`+`(op(sfkt));\n prt:=PartNM(N,N);\n i:= 1: while prt[i]<>[op(sfkt)] do i:=i+1 end do;\n add(KI[j,i]*h[op(prt[ j])],j=1..nops(prt));\nend proc:\ns_to_h:=proc(sfkt)\n option `Copyri ght (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n \+ local n1,prt,cf,term,lst;\n if sfkt=0 then return 0 end if;\n if sf kt=s[0] then return h[0] end if;\n if type(sfkt,`+`) then \n retur n map(procname,sfkt)\n elif type(sfkt,`*`) then\n term,cf:=selectr emove(type,sfkt,sfktmonom);\n return cf*procname(term)\n else\n \+ return s_to_hM(sfkt)\n end if; \nend proc:\n######################## #######################################################\n#\n# sfktmon_ to_hmatrix transforms a sfktmonom (Schur basis function) into\n# -- \+ a matrix in such a way, that the determinant of the matrix w.r.t\n# \+ -- the outer product yields back the Schur function monom.\n# -- the entries of the matrix are one part Schur functions, and hence\n# -- can be multiplies by teh outer product in teh complete symmetric func tion\n# -- basis, this gives teh Jacobi-Trudi formula for Schur func tions\n# -- s_\\lambda = det( h_[\\lambda_i-i+j]) \n# -- (there is a similar formula for the elementray symetric functions)\n#\nsfktmon_ to_hmatrix:=proc(x)\n local l,f,dim,lst;\n l,dim:=nops([op(x)]),0;\n if nargs=2 then l:=max(l,args[2]) end if;\n lst:=[op(x),0$(l-nops([ op(x)]))];\n f:=(x)->if x<0 then 0 else h[x] end if;\n evalm(linalg[ matrix](l,l,(i,j)->f(lst[i]-i+j)));\nend proc:\n#\n# s_to_hmat transfo rms an sfunction into a Toeplitz matrix of complete one part\n# -- \+ symmetric functions. It takes as a second argument a dimension, which \+ can\n# -- be taken to be the largest length of all involved partiti ons in teh sfktpolynom\n# -- see : \"maxlengthSymFkt()\" below\n#\n s_to_hmat:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz \+ 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,dim;\n \+ if nargs=2 then dim:=args[2] else dim:=NULL end if;\n if type(x,`+`) \+ then \n return map(procname,x,dim);\n elif type(x,`*`) then \n \+ tm,cf:=selectremove(type,x,sfktmonom);\n return cf*procname(tm,dim) \n else\n sfktmon_to_hmatrix(x,dim); \n end if;\nend proc:\n#\n# evalJacobiTrudiMatrix given an Jacobi-Trudin matrix (say from sfktmon _to_hmatrix)\n# -- this function evaluates the determinant w.r.t. t he outer product in the \n# -- complete symmetric function basis. \+ \n#\nevalJacobiTrudiMatrix:=proc(matrix)\n local mdim,lst,i,k,l;\n m dim:=linalg[rowdim](matrix);\n if mdim=1 then return matrix[1,1] end \+ if;\n lst:=[seq(i,i=1..mdim)];\n add((-1)^(i-1)*expand(outerH(matrix [i,1],\n procname(linalg[submatrix](\n matrix,map(x->if x=i \+ then NULL else x end if,lst),[seq(k,k=2..mdim)]))))\n ,i=1..mdim); \nend proc:\n#\n# s_to_hJT linear version of the transition from the s -basis into the h-basis\n# -- useing the Jacobi-Trudi formula\n#\ns_ to_hJT:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 200 3-2008. All rights reserved.`,\n remember;\n local cf,tm;\n if type (x,`+`) then \n return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return cf*procname(tm) \n else\n evalJacobiTrudiMatrix(sfktmon_to_hmatrix(x)); \n end i f;\nend proc:\n#\n# maxlengthSymFkt gives the maximal length of a part ition index in a\n# -- symfktpolynom of type \{s,p,m,h,f,e\}\n#\n#\nm axlengthSymFkt:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamo wicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm;\n \+ if type(x,`+`) then \n return max(op(map(procname,[op(x)])));\n e lif type(x,`*`) then \n tm,cf:=selectremove(type,x,symfktmonom);\n \+ return nops([op(tm)])\n else\n return nops([op(x)]) \n end if ;\nend proc:\n######################################################## #######################\n#\n# etoh is the transition from elementary t o complete symmetric functions for\n# -- one part elementary symme tric functions e_n. It is doen using the fact\n# -- that the gener ating functions H_t=\\sum_n \{n]t^n and E_-t = \\sum_m (-1)^m \{1^m\}t ^m\n# -- are inverse series under the pointwise product of functio ns\n# -- Note: H_t = M_t and E_-t = M_t[-s_1] = \\sum_n S(\{n\})t^ n\n#\netoh:=proc(x)\n local n;\n n:=op(x);\n if n=1 then return h[1 ] elif n=0 then return h[0] end if;\n add((-1)^(n-r-1)*outerH(h[n-r], procname(e[r])),r=0..n-1);\nend proc:\n#\n# e_to_hM is the basis chang e e_to_h on a single efktmonom, it uses the fact that the '\n# -- \+ elementary symmetric functions for a multiplicative basis and employs \+ `etoh'\n#\ne_to_hM:=proc(x)\n local prt;\n prt:=[op(x)];\n outerH(o p(map(etoh,map(x->[x],prt))));\nend proc:\n#\n# e_to_h linear version \+ of the transformation of elementary functions into complete functions \n#\ne_to_h:=proc(mfkt)\n local cf,term,lst;\n if type(mfkt,`+`) the n \n return map(procname,mfkt)\n elif type(mfkt,`*`) then\n ter m,cf:=selectremove(type,mfkt,efktmonom);\n return cf*procname(term) \n else\n e_to_hM(mfkt);\n end if; \nend proc:\n#\n# e_to_sM is t he transition fromelementary symmetric function monoms to Schur functi ons\n# -- it uses the fact that e_k=s[1,1,...,1] (k ones) \n#\ne_to _sM:=proc(x)\n outerS(op(map((x)->s[1$x],[op(x)])));\nend proc:\n#\n# e_to_s linear version of the transformation of elementary functions i nto Schur functions\n#\ne_to_s:=proc(efkt)\n local cf,term,lst;\n if type(efkt,`+`) then \n return map(procname,efkt)\n elif type(efkt ,`*`) then\n term,cf:=selectremove(type,mfkt,efktmonom);\n retur n cf*procname(term)\n else\n e_to_sM(efkt);\n end if; \nend proc: \n#################################################################### ###########\n#\n# h_to_mM is the basis transformation from complete to monomial symmetric functions\n# -- it is computed along the lines o f Rota-Stein using the multiplicativity of \n# -- the complete basis . The coproduct is used in disguise in the formula\n# -- h_(n) = \\s um_\{\\mu|-n\} m_\\mu, and the multiplicativity is translated into\n# \+ -- the nonmultiplicative outerM product.\n#\nh_to_mM:=proc(x)\n loc al lst,f;\n f:=(x)->add(m[op(i)],i=PartNM(x,x));\n if x=0 then \n \+ return 0\n elif x=h[0] then\n return m[0]\n end if;\n lst:=[op( x)];\n outerM(op(map(f,lst)));\nend proc:\n#\n# h_to_m linear version of the transformation of complete functions into monomial functions\n #\nh_to_m:=proc(hfkt)\n local cf,term,lst;\n if type(hfkt,`+`) then \+ \n return map(procname,hfkt)\n elif type(hfkt,`*`) then\n term, cf:=selectremove(type,hfkt,hfktmonom);\n return cf*procname(term)\n else\n h_to_mM(hfkt);\n end if; \nend proc:\n################### ############################################################\n#\n# p_t o_s transformes a power sum polynomial into an s-function polynomial. \n# This version was checked against SCHUR\n#\np_to_s:=proc(pfk t)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All r ights reserved.`;\n local n1,prt,cf,term,lst;\n if pfkt=0 then retur n 0 end if;\n if pfkt=p[0] or pfkt=p[] then return s[0] end if;\n if type(pfkt,`+`) then \n return map(procname,pfkt)\n elif type(pfkt ,`*`) then\n term,cf:=selectremove(type,pfkt,pfktmonom);\n retur n cf*procname(term)\n else\n n1:=`+`(op(pfkt)); \n prt:=PartN M(n1,n1);\n add(s[op(i)]*MurNak([op(pfkt)],i),i=prt);\n end if; \n end proc:\n#\n# s_to_p transformes an s-function into power sums.\n# \+ This version was checked against SCHUR, but *differs*\n# \+ in that effect, that it does not introduce an artificial \n# fa ctor n! to avaoid fractional coefficients\n#\n#\ns_to_p:=proc(xfkt)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local cf,term,lst,mat,np,prt,i;\n if xfkt=0 then retu rn 0 end if;\n if xfkt=s[0] then return p[0] end if;\n if type(xfkt, `+`) then \n return map(procname,xfkt)\n elif type(xfkt,`*`) then \n term,cf:=selectremove(type,xfkt,sfktmonom);\n return cf*procn ame(term)\n else\n np:=`+`(op(xfkt));\n prt:=PartNM(np,np); \+ \n i:=1:\n while prt[i]<>[op(xfkt)] do i:=i+1 end do;\n #\n \+ #+++ use the Murnaghan-Nakayama rules directly without the matrix in version\n #\n add(1/zee(prt[k])*MurNak(prt[k],prt[i])*p[op(prt[k ])],k=1..nops(prt));\n end if; \nend proc:\n#\n# p_to_mM is an intern al function computing the transition from a power sum monomial\n# \+ into a monomial symmetric function. Internal use only.\n#\np_to_mM :=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008 . All rights reserved.`,\n remember;\n if x=0 then return 0 \+ end if;\n if nops([op(x)])<1 then return m[0] end if;\n outerM(seq(m [op([op(x)][k])],k=1..nops([op(x)])))\nend proc:\n#\n# p_to_m linear v ersion of the transformation of power sums into monomial functions\n# \np_to_m:=proc(pfkt)\n option `Copyright (c) B. Fauser & R. Ablamowic z 2003-2008. All rights reserved.`;\n local cf,term,lst;\n if type(p fkt,`+`) then \n return map(procname,pfkt)\n elif type(pfkt,`*`) t hen\n term,cf:=selectremove(type,pfkt,pfktmonom);\n return cf*pr ocname(term)\n else\n p_to_mM(pfkt);\n end if; \nend proc:\n#\n# \+ m_to_pM transferes monomial symmetric function basis monoms into power sum symmetric\n# functions. Internal use only. \n#\n# SLOW!! \+ This routine uses matrix inversion and not a direct combinatorial algo rithm !!! \n#\nm_to_pM:=proc(mfkt)\n option `Copyright (c) B. Fauser \+ & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember; \n local nm,np,mat,prt,k;\n if mfkt=0 then return 0 end if;\n if mf kt=m[0] then return p[0] end if;\n nm:=`+`(op(mfkt));\n prt:=PartNM( nm,nm);\n np:=nops(prt);\n mat:=linalg[matrix](np,np,(i,j)->coeff(p_ to_mM(prt[i]),m[op(prt[j])]));\n mat:=evalm(mat^(-1));\n k:=1: while prt[k]<>[op(mfkt)] do k:=k+1; end do:\n add(mat[k,i]*p[op(prt[i])],i =1..nops(prt));\nend proc:\n#\n# m_to_p linear version of the transfor mation of monomial functions into power sums\n#\nm_to_p:=proc(mfkt)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local cf,term,lst;\n if type(mfkt,`+`) then \n ret urn map(procname,mfkt)\n elif type(mfkt,`*`) then\n term,cf:=selec tremove(type,mfkt,mfktmonom);\n return cf*procname(term)\n else\n \+ m_to_pM(mfkt);\n end if; \nend proc:\n#\n# makeRimRep is a cast fr om a partition into a representation of a \n# partition by \+ noting its NE-N directions by 1-0 symbols\n# This sequence \+ is infinite having infinit many leading 0\n# and traling 1s \n#\nmakeRimRep:=proc(part)\n option `Copyright (c) B. Fauser & R. A blamowicz 2003-2008. All rights reserved.`\n ,remember;\n l ocal n1,diff,res,i;\n n1:=nops(part);\n diff:=[part[-1],seq(-part[ n1+1-i]+part[n1-i],i=1..n1-1)];\n res:=[];\n for i from 1 to nops( diff) do\n res:=[op(res),seq(1,j=1..diff[i]),0];\n end do;\n \+ res;\nend proc:\n#\n# removeRimHook removes a rim hook (edgewise cone cted boundary strip)\n# of length hocklength in all pos sible ways. It returns \n# a list with the rimrepresent ed partitions of the remaining\n# part of the partition and a list with the rimheight attached to\n# the remov ed hoocks.\n#\nremoveRimHook:=proc(rimrep,hooklength)\n option `Copy right (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`, \n remember;\n local i,j,mult,redrimrep,rimhieght,nrr,tmpri m,del0,del1;\n redrimrep:=[];\n rimhieght:=[];\n nrr:=nops(rimre p);\n for i from 1 to nrr-1 do\n if rimrep[i]=1 then\n for j from i+1 to nrr do\n if rimrep[j]=0 then\n if j-i =hooklength then\n tmprim:=rimrep;\n tmprim[i] :=0;\n tmprim[j]:=1; \n redrimrep:=[op(redrimr ep),tmprim];\n rimhieght :=[op(rimhieght),\n \+ `+`(op(map(x->if x=0 then 1 else 0 end if,[seq(tmprim[k],k =i+1..j-1)])))] \n end if; \n end if; \+ \n end do; \n end if;\n end do;\n###############\n \+ del0:=proc(lst)\n local flag;\n flag:=false;\n ma p(x->if x=0 and flag=false then return NULL else flag:=true; return x \+ end if,lst); \n end proc:\n del1:=proc(lst)\n local f lag,f,res,i;\n flag:=false;\n f:=x->if x=1 and flag=fals e then return NULL else flag:=true; return x end if;\n res:=[]; \n for i from nops(lst) to 1 by -1 do\n res:=[f(lst[i] ),op(res)];\n end do; \n end proc:\n################ \n map(del0,map(del1,redrimrep)),rimhieght;\nend proc:\n#\n# MurNakRim This is the function which computes the Murnaghan Nakayama rule\n# \+ in terms of the rim representation of a shape. It is internal, \n# since rim representations of shapes are not supported on the user \n# side of the package.\n#\nMurNakRim:=proc(rimRe p,part2)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008 . All rights reserved.`,\n remember;\n local pt1,pt2,lst,si gn;\n if nops(part2)=1 then\n lst,sign:=removeRimHook(rimRep,pa rt2[1]);\n return add((-1)^i,i=sign);\n else\n pt1:=part2[ 1];\n pt2:=part2[2..-1];\n lst,sign:=removeRimHook(rimRep,pt 1);\n return add((-1)^sign[i]*procname(lst[i],pt2),i=1..nops(lst) );\n end if;\nend proc:\n#\n# MurNak This function provides the inte rface for the function MurNakRim to\n# compute the Murnaghan-Na kayama rule. This function returns the character\n# value of an S_n character with cycletype part1 on an element of S_n\n# wit h cycletype part2.\n#\nMurNak:=proc(part1,part2)\n option `Copyright \+ (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n if `+`(op(part1))<>`+`(op(part2)) then \n # -- Th is function is graded, for different grades return zero \n return 0 ;\n else\n # -- else use MurNakRim which needs a rim representatio n in the first argument\n # -- MurNak is _not_ symmetric in its ent ries\n return MurNakRim(makeRimRep(part2),part1);\n end if;\nend p roc:\n#\n# CharHook compute the character if pfkt is a one part partition power\n# sum. The result is zero unless sfkt= \{a+1,1^b\} is a Hook in which case\n# the value of the chara cter is (-1)^b, the height of the hook (leglength)\n#\nCharHook:=proc( sfkt,pfkt)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-20 08. All rights reserved.`,\n remember;\n local spart,ppart, ns,np;\n spart:=[op(sfkt)];\n ppart:=[op(pfkt)];\n np:=ppart[1]; \n ns:=`+`(op(spart));\n if ns<>np then return 0 end if;\n## -- ch eck if s is a hook\n if spart[1]+nops(spart)-1<>ns then return 0 end if;\n (-1)^(nops(spart)-1); \nend proc:\n#\n# sq_coeff returns t he square of the coefficients of a symmetric\n# function poly nomial of a certain type.\n#\n#\nsq_coeff:=proc(x,typ::type)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserv ed.`;\n local lst;\n if x=0 then \n return 0\n elif type(x,`+`) then \n lst:=[op(x)];\n else \n lst:=[x];\n end if;\n lst:=m ap(x->if type(x,`*`) then remove(type,x,typ) else 1 end if,lst);\n ad d(i^2,i=lst);\nend proc:\n#\n#\n#\n# MurNak2 is a function which as a \+ proof of concept shows how the Murnaghan Nakayama\n# rule can \+ be evaluatedon base of the Littlewood Richardson rule and the\n# \+ character formula on Hook Shapes \\Chi^\\lambda_n=Scalar(s_\\lambda ,p[n]). It\n# is much slower than the rimRep based function.\n #\n# WARINING: MurNak2 needs FLAT and MLIN which make functions associ ative and multilinear\n# This should be replaced by a better v ersion of 'define' which specifies not\n# the base ring, but t he types of the generating basis elemnts.\n#\nMurNak2:=proc(sfkt,pfkt) \n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All ri ghts reserved.`\n ,remember;\n local spart,ppart,ns,np,sw,C H;\n spart:=[op(sfkt)];\n ppart:=[op(pfkt)];\n sw:=proc() T(args [1],args[3],args[2],args[4]) end proc:\n CH:=proc() CharHook(args[1] ,args[2])*MurNak2(args[3],args[4]) end proc: \n if nops(pfkt)=1 then \n return CharHook(sfkt,pfkt);\n else\n T(subs(`&t`=T,cout er(sfkt)),s[ppart[1]],s[op(ppart[2..-1])]);\n FLAT(eval(subs(T=MLI N,%)));\n eval(subs(T=sw,%));\n eval(subs(T=CH,%));\n end if ;\nend proc:\n########################################\n#\n# dimSN_mon computes the dimension of an SN character\n# according to t he hook rule for an Sn character\n# s[lambda] (Schur functio n monom)\n# ++ dimSN(s[\\lambda]) = \n# ++ facto rial(|\\lambda|)/\\prod_\{i,j\} h_ij where\n# ++ h_ij is \+ the length of the hook at position (i,j)\n# ++ in the Youn g diagram of \\lambda \n#\n#\ndimSN_mon:=proc(x)\n option `Copyright \+ (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,remembe r;\n local part,part_conj,np,i,j,hooks;\n part:=[op(x)];\n if part= [0] then return 0 end if;\n np:=nops(part);\n part_conj:=conjpart(pa rt);\n hooks:=1;\n for i from 1 to np do\n for j from 1 to part[i] \+ do\n hooks:=hooks *( (part[i]-j+1)+max(part_conj[j]-i , 0) );\n# \+ print(i,j,\"---\",(part[i]-j+1),max(part_conj[j]-i , 0),\n# \+ \" : \",(part[i]-j+1)+max(part_conj[j]-i , 0), hooks);\n end do;end do;\n factorial(`+`(op(part)))/hooks;\nend proc:\n#\n# dimSN is the \+ multilinear version of simSN_mon\n#\ndimSN:=proc(x)\n option `Copyrig ht (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n \+ local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n return map( procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremove(type ,x,sfktmonom);\n return cf*procname(tm,y)\n else\n dimSN_mon(x) ; \n end if;\nend proc:\n########################################### ####################################\n#\n# G E S S E L T H E T A funct ions\n#\n############################################################# ##################\n#\n# GesselTheta is the Gessel map from a polynomi al ring in infinitely many\n# (finitely many) variables 'u1,u2,u3, ...' into a polynomial ring\n# in one variable 'z', say. The map i s ussefull for counting purposes and\n# defined as follows:\n#\n# \+ -- i) \\Theta(1) = 1\n# -- ii) \\Theta(p_n(u)) = z if n=1 else 0\n# \n# we have therefore for S-functiuons\n#\n# -- iii) \\Theta(s_\\l ambda(u)) = f^\\lambda z^(|\\lambda|) / (|\\lambda|)!\n#\n# where | \\lambda| is the weight of a partition lambda and\n# f^\\lambda is \+ the number of standard Young tableau of shape\n# \\lambda i.e. SYT( \\lambda)=dimSN(s[\\lambda](u))\n#\n################################## #############################################\n#\n# GesselThetaP_mon i s the theta function given for power sum monomials\n#\nGesselThetaP_mo n:=proc(x,var)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003 -2008. All rights reserved.`,\n remeber;\n local n;\n if (x=p[0] or x=1) then return 1 end if;\n n:=nops([op(x)]);\n if n=`+`(op(x)) th en var^n else 0 end if;\nend proc:\n#\n# GesselThetaP is the linear ve rsion for the Gessel map theta for \n# power sum polynomi als\n#\nGesselThetaP:=proc(x,var)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local cf,tm;\n if type(x,`+`) then \n return map(procname,x,var);\n elif type(x,`*` ) then \n tm,cf:=selectremove(type,x,pfktmonom);\n return cf*Ges selThetaP_mon(tm,var)\n else\n GesselThetaP_mon(x,var); \n end i f;\nend proc:\n#\n# GesselThetaS_mon is the theta function given for S chur function monomials\n#\nGesselThetaS_mon:=proc(x,var)\n option `C opyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved. `,\n remeber;\n local N;\n if (x=s[0] or x=1) then return 1 end if; \n N:=`+`(op(x));\n dimSN(x)*var^N/factorial(N); \nend proc:\n#\n# G esselThetaS is the linear version for the Gessel map theta for \n# \+ Schur function polynomials\n#\nGesselThetaS:=proc(x,var)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights \+ reserved.`;\n local cf,tm;\n if type(x,`+`) then \n return map(pr ocname,x,var);\n elif type(x,`*`) then \n tm,cf:=selectremove(type ,x,sfktmonom);\n return cf*GesselThetaS_mon(tm,var)\n else\n Ge sselThetaS_mon(x,var); \n end if;\nend proc:\n\n#################### ####################\n#\n# Functions for s-functions\n#\n############# ###########################\n\n\n##################################### ###########################################\n#\n# S C A L A R PRODUCTS \n#\n# for different bases\n#\n################################### #############################################\n#\n# +++ scalar product of schur functions\n#\nScalar:=proc(x,y)\n option `Copyright (c) B. \+ Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local cf,t m,p1,p2;\n if x=0 or y=0 then return 0 end if;\n if not (type(x,sfkt polynom) and type(y,sfktpolynom)) then error \"wrong type\\n\" end if; \n if type(x,`+`) then \n return map(procname,x,y);\n elif type(x ,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return cf *procname(tm,y)\n else\n if type(y,`+`) then \n return map2(p rocname,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(ty pe,y,sfktmonom);\n return cf*procname(x,tm)\n else\n p1:= getPart(x):p2:=getPart(y):\n if nops(p1)nops(p2) then p2:=[op (p2),0$(nops(p1)-nops(p2))];\n end if;\n if \{op(zip((i,j)-> i-j,p1,p2))\}=\{0\} then return s[0] else return 0 end if;\n end if ;\n end if;\nend proc:\n############################################# ########################################\n#\n# scalarP is the Schur-Ha ll scalar product on power sum functions\n#\nScalarP:=proc(x,y)\n opt ion `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights res erved.`;\n local cf,tm,p1,p2;\n if not (type(x,pfktpolynom) and type (y,pfktpolynom)) then error \"wrong type\\n\" end if;\n if type(x,`+` ) then \n return map(procname,x,y);\n elif type(x,`*`) then \n \+ tm,cf:=selectremove(type,x,pfktmonom);\n return cf*procname(tm,y)\n else\n if type(y,`+`) then \n return map2(procname,x,y);\n \+ elif type(y,`*`) then\n tm,cf:=selectremove(type,y,pfktmonom); \n return cf*procname(x,tm)\n else\n ###\n p1:=[op(x )];\n p2:=[op(y)];\n if `+`(op(p1))<>`+`(op(p2)) then return 0 end if;\n if \{op(zip((x,y)->x-y,p1,p2))\}=\{0\} then \n \+ return zee(p1) \n end if;\n 0;\n ### \n end if;\n \+ end if;\nend proc:\n################################################# #################################\n#\n# ScalarMH is the Schur-Hall sca lar product for the dual pair of complete symmetric \n# funct ions and monomial symmetric functions. Alias is ScalarHM\n#\n#\nScalar MH:=proc(x,y)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003 -2008. All rights reserved`;\n if x=0 or y=0 then return 0 end if;\n if type(x,mfktpolynom) and type(y,hfktpolynom) then \n return \+ Scalar(subs(`m`=s,x),subs(`h`=s,y)) end if;\n if type(x,hfktpolyn om) and type(y,mfktpolynom) then \n return Scalar(subs(`h`=s,x),s ubs(`m`=s,y)) end if;\n error \"unknown type in ScalarHM\";\nend pro c:\nScalarHM:=ScalarMH;\n############################################# ########################################\n#\n# O U T E R MONOID\n#\n## ###################################################################### #############\n#\n#\n# outer product for S functions, this is the defa ult proceedure, alias is outerS\n#\nouter:=proc(x)\n option `Copyrigh t (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n l ocal cf,tm,p1,p2,y;\n if nargs=1 then return x end if;\n y:=args[2]; \n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return proc name(procname(x,y),args[3..-1]) end if;\n if not(type(x,sfktpolynom) \+ and type(args[2],sfktpolynom)) then error \"wrong type\\n\" end if;\n \+ if type(x,`+`) then \n return map(procname,x,y);\n elif type(x,`* `) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return cf*pr ocname(tm,y)\n else\n if type(y,`+`) then \n return map2(proc name,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(type, y,sfktmonom);\n return cf*procname(x,tm)\n else\n if x=0 \+ or y=0 then return 0 end if;\n p1:=getPart(x): p2:=getPart(y):\n# +++ it is faster to add fewer boxes\n# --- the product is symmetric\n if `+`(op(p1))<`+`(op(p2)) then \n return LRR(p2,p1);\n \+ else\n return LRR(p1,p2);\n end if;\n end if;\n en d if;\nend proc:\n#\n# +++ alias for outer product in Schur function b asis\n#\nouterS:=outer:\n#\n#\n# concatM_mon multiplies two monomials \+ (mfktmonom) using the divided power representation of \n# \+ Rota-Stein 94\n# WARNING: this is _not_ the outer product of symmet ric functions, but a concatenation \n# product in a divide d powers algebra!\n#\n# (Internal use only)\n#\nconcatM_mo n:=proc(fkt1,fkt2)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local mset1,mset2 ,n1,n2,N,lst,cf,res,i;\n if fkt1=0 or fkt2=0 then return 0 end if;\n mset1,mset2:=part2mset([op(fkt1)]),part2mset([op(fkt2)]);\n n1,n2 :=nops(mset1),nops(mset2);\n if n1>n2 then\n N:=n1;\n mset2: =[op(mset2),0$(n1-n2)];\n elif n2>n1 then\n N:=n2;\n mset1:= [op(mset1),0$(n2-n1)];\n else\n N:=n1;\n end if;\n lst:=[seq ([binomial(mset1[i]+mset2[i],mset1[i]),mset1[i]+mset2[i]] ,i=1..N)];\n cf,res:=1,[];\n for i in lst do\n cf:=cf*i[1];\n res:=[op (res),i[2]];\n end do; \n cf*m[op(mset2part(res))];\nend proc:\n #\n# concatM provides the concatemation product of m-functions (not th e outer product of \n# symmetric functions!) This product is n eeded to produce a 'clifford' type\n# product for the outer m- function product\n#\n#\nconcatM:=proc(x)\n option `Copyright (c) B. F auser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2,y;\n if nargs=1 then return x end if;\n y:=args[ 2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return p rocname(procname(x,y),args[3..-1]) end if;\n if not(type(x,mfktpolyno m) and type(args[2],mfktpolynom)) then error \"wrong type\\n\" end if; \n if type(x,`+`) then \n return map(procname,x,y);\n elif type(x ,`*`) then \n tm,cf:=selectremove(type,x,mfktmonom);\n return cf *procname(tm,y)\n else\n if type(y,`+`) then \n return map2(p rocname,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(ty pe,y,mfktmonom);\n return cf*procname(x,tm)\n else\n if x =0 or y=0 then return 0 end if;\n concatM_mon(x,y)\n end if;\n end if;\nend proc:\n#\n#\n# concat_mon multiplies two monomials (e-, h-, p-function monoms) \n# This is the outer product! \n# \n# (Internal use only)\n#\nconcat_mon:=proc(fkt1,fkt2,nam e)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All \+ rights reserved.`,\n remember;\n local lst;\n lst:=[op(fkt1),op( fkt2)];\n name[op(sort(lst,(i,j)->if i>j then true else false end if ))];\nend proc:\n#\n# outerH,E,P are functions providing the outer pro duct of complete, elementary and power sum\n# symmetric functi ons. These products are the outer products on these bases, since\n# \+ these particular bases are multiplicateive bases.\n#\n#\nouterH: =proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2,y;\n if nar gs=1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return procname(procname(x,y),args[3..-1 ]) end if;\n if not(type(x,hfktpolynom) and type(y,hfktpolynom)) then error \"wrong type\\n\" end if;\n if type(x,`+`) then \n return m ap(procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremove(t ype,x,hfktmonom);\n return cf*procname(tm,y)\n else\n if type(y ,`+`) then \n return map2(procname,x,y);\n elif type(y,`*`) th en\n tm,cf:=selectremove(type,y,hfktmonom);\n return cf*proc name(x,tm)\n else\n if x=0 or y=0 then return 0 end if;\n \+ if x=h[0] then return y end if;\n if y=h[0] then return x end if ;\n concat_mon(x,y,`h`)\n end if;\n end if;\nend proc:\n#\n# \n#\nouterE:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowic z 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2, y;\n if nargs=1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return procname(procname(x,y ),args[3..-1]) end if;\n if not(type(x,efktpolynom) and type(args[2], efktpolynom)) then error \"wrong type\\n\" end if;\n if type(x,`+`) t hen \n return map(procname,x,y);\n elif type(x,`*`) then \n tm, cf:=selectremove(type,x,efktmonom);\n return cf*procname(tm,y)\n e lse\n if type(y,`+`) then \n return map2(procname,x,y);\n e lif type(y,`*`) then\n tm,cf:=selectremove(type,y,efktmonom);\n \+ return cf*procname(x,tm)\n else\n if x=0 or y=0 then retur n 0 end if;\n if x=e[0] then return y end if;\n if y=e[0] th en return x end if;\n concat_mon(x,y,`e`)\n end if;\n end if; \nend proc:\n#\n#\n#\nouterP:=proc(x)\n option `Copyright (c) B. Faus er & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n l ocal cf,tm,p1,p2,y;\n if nargs=1 then return x end if;\n y:=args[2]; \n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return proc name(procname(x,y),args[3..-1]) end if;\n if not(type(x,pfktpolynom) \+ and type(args[2],pfktpolynom)) then error \"wrong type\\n\" end if;\n \+ if type(x,`+`) then \n return map(procname,x,y);\n elif type(x,`* `) then \n tm,cf:=selectremove(type,x,pfktmonom);\n return cf*pr ocname(tm,y)\n else\n if type(y,`+`) then \n return map2(proc name,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(type, y,pfktmonom);\n return cf*procname(x,tm)\n else\n if x=0 \+ or y=0 then return 0 end if;\n if x=p[0] then return y end if;\n \+ if y=p[0] then return x end if;\n concat_mon(x,y,`p`)\n e nd if;\n end if;\nend proc:\n######################################## ################################################\n#\n# O U T E R COMON OID\n#\n#\n########################################################### #############################\n#\n# couterM_mon computes the outer cop roduct of the m-basis m-functions\n#\n# (Internal use only)\n#\ncouter M_mon:=proc(mfkt)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2 003-2008. All rights reserved.`,\n remember;\n local mset,T,res,nT; \n mset:=part2mset([op(mfkt)]);\n T:=combinat[cartprod]([seq([seq(k, k=0..mset[i])],i=1..nops(mset))]):\n res:=[];\n while not T[finished ] do\n nT:=T[nextvalue](); \n res:=[op(res),[mset-nT,nT]] \n en d do;\n add(&t(m[op(mset2part(i[1]))],m[op(mset2part(i[2]))]),i=res); \nend proc:\n#\n#\n# couterM computes the outer coproduct in the m-bas is. This is essentially a wrapper\n# function for couterM_mon \+ on monomials, making it multilinear over the\n# integers.\n#\n #\ncouterM:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,n1,plst 1,plst2,i;\n if type(x,`+`) then \n return map(procname,x,y);\n e lif type(x,`*`) then \n tm,cf:=selectremove(type,x,mfktmonom);\n \+ return cf*procname(tm,y)\n else\n if x=m[0] then return &t(m[0],m [0]) end if;\n couterM_mon(x); \n end if;\nend proc:\n#\n# Laplac eMset is a internal function which implements the Laplace Pairing of R ota-Stein\n# in tha case of monomial symmetric functions. \+ For efficiency reasons, it\n# uses a third representation \+ of sparse-multisets M(\\prod_k [i_k,ni_k])\n# where the ze ro entries [n,0] are omitted! \n#\n#\nLaplaceMset:=proc(Mset1,Mset2)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All right s reserved.`,\n remember;\n local n1,n2,T,nT,res,a,b,c,d;\n n1,n2:= nops(Mset1),nops(Mset2);\n # -- check for m[0]=1 cases directly\n if n1=0 and n2=0 then return M() end if;\n if n1=0 or n2=0 then return \+ 0 end if;\n if n1=1 then\n if n2=1 then\n # -- case n1=n2=1 d efinition applies directly\n if op(Mset1)[2]=op(Mset2)[2] then \n return M([op(Mset1)[1]+op(Mset2)[1],op(Mset1)[2]]);\n els e\n return 0;\n end if; \n else\n # --n1=1, n2 a p roduct\n return add(MCAT(\n procname( M([ op (Mset1)[1] , k ]) , M( op(Mset2)[1] ) )\n ,procnam e( M([ op(Mset1)[1] , op(Mset1)[2]-k ]), M( op(Mset2)[2..-1] ) ) \n \+ )\n ,k=0..op(Mset1)[2] );\n end \+ if;\n else\n # -- n1 a product\n if n2=1 then\n # -- n2 no t a product\n return add(MCAT(\n procname( M ([ op(Mset2)[1] , k ]) , M( op(Mset1)[1] ) )\n ,pr ocname( M([ op(Mset2)[1] , op(Mset2)[2]-k ]), M( op(Mset1)[2..-1] ) ) \n )\n ,k=0..op(Mset2)[2] );\n e lse\n # -- n1 and n2 products, expand second argument ...\n \+ a,b:=M([op(Mset1)][1]),M(op([op(Mset1)][2..-1]));\n c:=[seq([op(M set2)][i][1],i=1..nops([op(Mset2)]))];\n d:=[seq([op(Mset2)][i][2 ],i=1..nops([op(Mset2)]))];\n T:=combinat[cartprod]([seq([seq(k,k =0..[op(Mset2)][i][2])],i=1..nops([op(Mset2)]))]):\n res:=[];\n \+ while not T[finished] do\n nT:=T[nextvalue](); \n re s:=[op(res),[d-nT,nT]] \n end do;\n add(MCAT(\n \+ procname(a,M(seq([c[k],i[1][k]],k=1..nops(c)) ))\n ,pro cname(b,M(seq([c[k],i[2][k]],k=1..nops(c)) ))\n )\n \+ ,i=res);\n end if;\n end if;\nend proc:\n#\n# LaplaceM_mon is \+ the wrapper function for LaplaceMset and computes the Laplace pairing \n# between two _monomials_ in the monoamial symmetric functi on basis. Unless\n# it is bilinear it is for internal use in \+ the outerM product mainly.\n#\n#\nLaplaceM_mon:=proc(mfkt1,mfkt2)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights \+ reserved.`,\n remember;\n local mset1,mset2,f;\n# -- SPECIAL CASES \n# -- LaplaceM is _not_ graded, by weight of the partitions of the mf kt's\n# -- However, LaplaceM _is graded_ by the _length_ of the partit ions!!\n# -- The case m[0] is crittical since part2mset does return an empty list\n# -- we deal hence with these cases seperately:\n# -- Lap laceM(m[0],m[0])=m[0]\n# -- LaplaceM(m[0],) = 0 = LaplaceM(< any-mfkt>,m[0])\n if nops([op(mfkt1)])<>nops([op(mfkt2)]) then retur n 0 end if;\n if mfkt1=m[0] and mfkt2=m[0] then return m[0] end if; \n if mfkt1=m[0] or mfkt2=m[0] then return 0 end if;\n# -- transform partitions into msets M([i1,ni1],[i2,ni2],...)\n mset1,mset2:=part2 mset([op(mfkt1)]),part2mset([op(mfkt2)]);\n# -- f is a helper function which turns M-set representations back into\n# -- a partition represe ntation\n f:=proc()\n local x,n;\n x,n:=args,nargs;\n \+ m[op( sort([seq([x][k][1]$[x][k][2],k=1..n)]) )];\n end proc:\n# -- call the actual LaplaceMset proceedure\n LaplaceMset(M(seq([k,mset1 [k]],k=1..nops(mset1))),M(seq([k,mset2[k]],k=1..nops(mset2))));\n# -- \+ Turn the M-set representation output of LaplaceMset into a partition b ased form\n eval(subs(M=f,%));\n# -- substitute the unevaluated conc atenation product MCAT into the actual concatM product\n# -- and retur n the final result \n eval(subs(MCAT=concatM,%));\nend proc:\n#\n# T he wrapper which makes LaplaceM_mon multilinear\n#\nLaplaceM:=proc(x,y )\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All ri ghts reserved.`;\n local cf,tm,p1,p2;\n if x=0 or y=0 then return 0 \+ end if;\n if not (type(x,mfktpolynom) and type(y,mfktpolynom)) then e rror \"wrong type\\n\" end if;\n if type(x,`+`) then \n return map (procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremove(typ e,x,mfktmonom);\n return cf*procname(tm,y)\n else\n if type(y,` +`) then \n return map2(procname,x,y);\n elif type(y,`*`) then \n tm,cf:=selectremove(type,y,mfktmonom);\n return cf*procna me(x,tm)\n else\n# if x=m[0] then return y end if;\n# if \+ y=m[0] then return x end if;\n LaplaceM_mon(x,y);\n end if;\n \+ end if;\nend proc:\n#\n# outerM the cliffordization of the concatM pr oduct, the outer product in the monomial\n# symmetric function \+ basis. This function takes 1,2, or n variables (associactive)\n# \+ and is multilinear over the integers / fractions.\n#\n#\nouterM:=pro c(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2,y,f;\n if nargs =1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return procname(procname(x,y),args[3..-1]) end if;\n if not(type(x,mfktpolynom) and type(args[2],mfktpolynom)) \+ then error \"wrong type\\n\" end if;\n if type(x,`+`) then \n retu rn map(procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremo ve(type,x,mfktmonom);\n return cf*procname(tm,y)\n else\n if ty pe(y,`+`) then \n return map2(procname,x,y);\n elif type(y,`*` ) then\n tm,cf:=selectremove(type,y,mfktmonom);\n return cf* procname(x,tm)\n else\n if x=0 or y=0 then return 0 end if;\n \+ f:=(a,b,c,d)->concatM(LaplaceM_mon(a,c),concatM_mon(b,d));\n \+ eval(subs(`&t`=f,&t(couterM(x),couterM(y))));\n end if;\n end if; \nend proc:\n######################################################### ###############################\n#\n# A D J O I N T OPERATIONS / SKEWS \n#\n################################################################# #######################\n#\n# +++ skew shur functions\n#\nskew:=proc( x,y)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local cf,tm,n1,n2,n3,plst;\n if y=s[0] then re turn x; end if;\n if type(x,`+`) then \n return map(procname,x,y); \n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom); \n return cf*procname(tm,y)\n else\n if type(y,`+`) then \n \+ return map2(procname,x,y);\n elif type(y,`*`) then\n tm,cf:= selectremove(type,y,sfktmonom);\n return cf*procname(x,tm)\n e lse\n n1:=`+`(op(getPart(x))):n2:=`+`(op(getPart(y))):\n n3: =n1-n2;\n if n3<0 then return 0 \n elif n3=0 then return Sca lar(x,y) \n else\n plst:=map(x->s[op(x)],[op(PartNM(n3,n3) )]);\n return add(outer(Scalar(x,outer(y,z)),z),z=plst);\n \+ end if;\n end if;\n end if;\nend proc:\n#\n#\n#\ncouter:=proc(x) \n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rig hts reserved.`;\n local cf,tm,n1,plst1,plst2,i;\n if not type(x,sfkt polynom) then return x*procname(s[0]) end if;\n if type(x,`+`) then \+ \n return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=se lectremove(type,x,sfktmonom);\n return cf*procname(tm)\n else\n \+ if x=s[0] then return &t(s[0],s[0]) end if;\n n1:=`+`(op(getPart(x ))):\n tm:=&t(s[0],x)+&t(x,s[0]);\n for i from 1 to n1-1 do\n \+ plst1:=map(x->s[op(x)],PartNM(n1-i,n1));\n plst2:=map(x->s[o p(x)],PartNM(i,n1));\n tm:=tm+add(add(subs(s[0]=1,Scalar(x,outer (y,z)))*&t(y,z),y=plst1),z=plst2);\n end do;\n return tm;\n end if;\nend proc:\n#\n#\n# couterH_monom is the internal function comput ing the outer product on complete\n# symmetric functions \+ monoms\n#\n#\ncouterH_mon:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember ;\n local prtx,p1,f,g,l;\n prtx:=[op(x)];\n if prtx=[] or prtx=[ 0] then return &t(h[0],h[0]) end if;\n if nops(prtx)=1 then return a dd(&t(h[prtx[1]-i],h[i]),i=0..prtx[1]) end if;\n p1:=prtx[1];\n pr tx:=prtx[2..-1];\n f:=(x,y,z)->&t(x,z,y):\n l:=proc(x)\n h[op (subs(0=NULL,[op(x)]))]; \n if %=h[] then h[0] else % end if:\n \+ end proc:\n g:=(x,y,s,t)->&t(l(outerH(x,y)),l(outerH(s,t))):\n ev al(subs(`&t`=g,\n add(f(h[p1-i],h[i],procname(h[op(prtx)])) , i=0..p1) ));\nend proc:\n#\n#\n# couterH computes the outer coproduct \+ in the h-basis. This is essentially a wrapper\n# function for \+ couterH_mon on monomials, making it multilinear over the\n# in tegers.\n#\n#\ncouterH:=proc(x)\n option `Copyright (c) B. Fauser & R . Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local c f,tm,n1,plst1,plst2,i;\n ####if not type(x,efktpolynom) then return x *procname(h[0]) end if;#####<<<<&t(x,z,y):\n l:=proc(x)\n e[op(subs(0=NULL,[op(x)]))]; \+ \n if %=e[] then e[0] else % end if:\n end proc:\n g:=(x,y,s, t)->&t(l(outerE(x,y)),l(outerE(s,t))):\n eval(subs(`&t`=g,\n \+ add(f(e[p1-i],e[i],procname(e[op(prtx)])) ,i=0..p1) ));\nend proc:\n #\n#\n# couterE computes the outer coproduct in the e-basis. This is e ssentially a wrapper\n# function for couterE_mon on monomials, making it multilinear over the\n# integers.\n#\n#\ncouterE:=p roc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. A ll rights reserved.`,\n remember;\n local cf,tm,n1,plst1,plst2,i;\n \+ if not type(x,efktpolynom) then return x*procname(e[0]) end if;\n if type(x,`+`) then \n return map(procname,x,y);\n elif type(x,`*`) \+ then \n tm,cf:=selectremove(type,x,efktmonom);\n return cf*procn ame(tm,y)\n else\n couterE_mon(x); \n end if;\nend proc:\n#\n#\n # couterP_mon is the internal function computing the outer product on \+ power sum\n# symmetric functions monoms\n#\n#\ncouterP_mo n:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-20 08. All rights reserved.`,\n remember;\n local prtx,p1,f,g, l;\n prtx:=[op(x)];\n if prtx=[] or prtx=[0] then return &t(p[0],p [0]) end if;\n if nops(prtx)=1 then return &t(x,p[0])+&t(p[0],x) end if;\n p1:=prtx[1];\n prtx:=prtx[2..-1];\n f:=(x,y,z)->&t(x,z,y) :\n l:=proc(x)\n p[op(subs(0=NULL,[op(x)]))]; \n if %=p[] \+ then p[0] else % end if:\n end proc:\n g:=(x,y,s,t)->&t(l(outerP(x ,y)),l(outerP(s,t))):\n eval(subs(`&t`=g,\n f(p[p1],p[0],pr ocname(p[op(prtx)]))\n +f(p[0],p[p1],procname(p[op(prtx)])) )) ;\nend proc:\n#\n#\n# couterP computes the outer coproduct in the p-ba sis. This is essentially a wrapper\n# function for couterP_mon on monomials, making it multilinear over the\n# integers.\n# \n#\ncouterP:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowi cz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,n1,pl st1,plst2,i;\n if not type(x,pfktpolynom) then return x*procname(p[0] ) end if;\n if type(x,`+`) then \n return map(procname,x,y);\n el if type(x,`*`) then \n tm,cf:=selectremove(type,x,pfktmonom);\n \+ return cf*procname(tm,y)\n else\n couterP_mon(x); \n end if;\nen d proc:\n#\n# antipode for the Sfunctions\n#\n#\nantipS_mon:=proc(sfkt )\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All ri ghts reserved.`; \n local p1,Lambda,i,k,N;\n p1:=[op(sfkt)];\n if ` +`(op(p1))=0 then return s[0] end if;\n Lambda:=[0$`+`(op(p1))]:\n f or i from 1 to nops(p1) do\n for k from 1 to p1[i] do\n Lambda[k]: =Lambda[k]+1;\n end do: end do:\n Lambda:=map(x-> if x=0 then NULL e lse x end if ,Lambda); \n (-1)^(`+`(op(p1)))*s[op(Lambda)]; \nend p roc:\n#\n# linear version for the antipode of the Sfunctions\n#\n#\nan tipS:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003- 2008. All rights reserved.`,\n remember;\n local cf,tm,n1,plst1,plst 2,i;\n if type(x,`+`) then \n return map(procname,x);\n elif type (x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return \+ cf*procname(tm)\n else\n antipS_mon(x); \n end if;\nend proc:\n# \n# antipode in the power sum basis\n#\n#\nantipP_mon:=proc(pfkt)\n o ption `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights r eserved.`;\n (-1)^(nops([op(pfkt)]))*pfkt; \nend proc:\n#\n# linear f orm of the power sum antipode\n#\n#\nantipP:=proc(x)\n option `Copyri ght (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n \+ return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selec tremove(type,x,pfktmonom);\n return cf*procname(tm)\n else\n an tipP_mon(x); \n end if;\nend proc:\n#\n# antipH_mon is the recursive ly defined antipode for the complete symmetric \n# function s (internal use only)\n#\nantipH_mon:=proc(hfktmonom)\n option `Copyr ight (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local f;\n if op(hfktmonom)=0 then return h[0] \+ end if;\n f:=(x,y)->outerH(antipH_mon(x),y):\n eval(subs(`&t`=f,-cou terH(hfktmonom)+&t(hfktmonom,h[0])));\nend proc:\n#\n# antipH is the l inear version of antiH_mon\n#\nantipH:=proc(x)\n option `Copyright (c ) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remem ber;\n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n ret urn map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selectremov e(type,x,hfktmonom);\n return cf*procname(tm)\n else\n antipH_m on(x); \n end if;\nend proc:\n#\n# antipE_mon is the recursively def ined antipode for the elementary symmetric \n# functions (i nternal use only)\n#\nantipE_mon:=proc(efktmonom)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local f;\n if op(efktmonom)=0 then return e[0] end \+ if;\n f:=(x,y)->outerE(antipE_mon(x),y):\n eval(subs(`&t`=f,-couterE (efktmonom)+&t(efktmonom,e[0])));\nend proc:\n#\n# antipE is the linea r version of antiE_mon\n#\nantipE:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember; \n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n return \+ map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selectremove(ty pe,x,efktmonom);\n return cf*procname(tm)\n else\n antipE_mon(x ); \n end if;\nend proc:\n#\n# antipM_mon is the recursively defined antipode for the monomial symmetric \n# functions (interna l use only)\n#\nantipM_mon:=proc(mfktmonom)\n option `Copyright (c) B . Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n r emember;\n local f;\n if op(mfktmonom)=0 then return m[0] end if;\n \+ f:=(x,y)->outerM(antipM_mon(x),y):\n eval(subs(`&t`=f,-couterM(mfktm onom)+&t(mfktmonom,m[0])));\nend proc:\n#\n# antipM is the linear vers ion of antipM_mon\n#\nantipM:=proc(x)\n option `Copyright (c) B. Faus er & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n l ocal cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \n return map(p rocname,x);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x, mfktmonom);\n return cf*procname(tm)\n else\n antipM_mon(x); \+ \n end if;\nend proc:\n#\n# antip_MC_mon is the antipode on mfktmonom w.r.t the convolution formed by\n# -- outer corpoduct and the conc atM (unordered) concatenation product.\n#\nantipMC_mon:=proc(x)\n loc al f;\n if x=m[0] then \n return m[0]\n elif x=m[1] then \n \+ return -m[1] \n end if;\n # -- recursive version\n # f:=(x,y)->con catM(antipMC_mon(x),y):\n # eval(subs(`&t`=f,&t(-couterM(x)+&t(x,m[0 ]))));\n (-1)^nops([op(x)])*x;\nend proc:\n#\n# linear version for th e antipode of the Hopf algebra of outer coproduct and concatenation\n# -- in the monomial basis...\n#\n#\nantipMC:=proc(x)\n option `Copy right (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`, \n remember;\n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) then \+ \n return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=se lectremove(type,x,mfktmonom);\n return cf*procname(tm)\n else\n \+ antipMC_mon(x); \n end if;\nend proc:\n############################ ############################################################\n#\n# T A B L E S\n#\n######################################################### ###############################\n#\n# KostkaTable returns an equation \+ Kostka'N'=matrix where matrix is the matrix of\n# Kostka n umbers in the anti lexicographic ordering of partitions\n#\nKostkaTabl e:=proc(N::integer)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n local part,sn,mks;\n mks:=(lst )->map(i->s[op(i)],lst);\n part:=PartNM(N,N);\n sn:=map(i->mks(i),pa rt);\n cat(Kostka,N)=subs(s[0]=1,evalm(linalg[matrix](nops(part),nops (part),(i,j)->Scalar( s[op(part[i])],outer(op(sn[j]))))));\nend proc: \n#\n# LaplaceTable returns the matrix of the Rota-Stein Laplace pairi ng for the monomial\n# symmetric function deformation. It is presented in the graded anti\n# lexicographic orderin g, which respects the grading of the Laplace\n# pairing ( block diagonal form). First row and colums show the basis \n# \+ partitions\n#\nLaplaceTable:=proc(N,M)\n option `Copyright (c) B . Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local pr tN,prtM;\n prtN,prtM:=sort(PartNM(N,N),grAlexComp),sort(PartNM(M,M),g rAlexComp);\n linalg[matrix](nops(prtN)+1,nops(prtM)+1,\n (i,j) ->if i=1 and j=1 then \n `` elif j=1 then \n \+ prtN[i-1] elif i=1 then \n prtM[j-1] else \+ \n LaplaceM_mon(prtN[i-1],prtM[j-1]) \n en d if);\nend proc:\n\n################################################# #########################\n#\n# I N N E R MONOID and COMONOID\n#\n# \+ Power Sum Basis \n#\n######################################### #################################\n\n################################# #########################################\n#\n# innerH_mon the inner p roduct of symmetric functions in the h-basis\n# -- it is based on \+ the Laplace property of the inner and outer products\n# -- i) (a. b) o c = \\sum_(c) (a o c_(1)) . (b o c_(2))\n# -- ii) c o (a.b) \+ = \\sum_(c) (c_(1) o a) . (c_(2) o b)\n# -- where we have used:\n # -- . outer product\n# -- \\Delta(c)= \\sum_(c) c_(1) otime s c_(2) outer coproduct\n# -- o inner product \n#\ninnerH_mon:=pr oc(hfktmon1,hfktmon2)\n local n,m,coh,f;\n n,m:=nops([op(hfktmon1)]) ,nops([op(hfktmon2)]);\n if `+`(op(hfktmon1))<> `+`(op(hfktmon2)) the n\n return 0;\n elif n=1 then\n return hfktmon2;\n elif m=1 \+ then\n return hfktmon1;\n elif nouter H(innerH_mon(a,x),innerH_mon(b,y)); \n coh:=&t(couterH(hfktmon1),h [[op(hfktmon2)][1]],h[op([op(hfktmon2)][2..-1])]);\n return eval(s ubs(`&t`=f,coh));\n else\n f:=(a,b,x,y)->outerH(innerH_mon(a,x),i nnerH_mon(b,y)); \n coh:=&t(couterH(hfktmon2),h[[op(hfktmon1)][1]] ,h[op([op(hfktmon1)][2..-1])]);\n return eval(subs(`&t`=f,coh));\n end if;\nend proc:\n#\n# innerH is the linear version of innerH_mon \n#\n#\ninnerH:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamo wicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1, p2,y,f;\n if nargs=1 then return x end if;\n y:=args[2];\n if x=0 o r y=0 then return 0 end if;\n if nargs>2 then return procname(procnam e(x,y),args[3..-1]) end if;\n if not(type(x,hfktpolynom) and type(arg s[2],hfktpolynom)) then error \"wrong type\\n\" end if;\n if type(x,` +`) then \n return map(procname,x,y);\n elif type(x,`*`) then \n \+ tm,cf:=selectremove(type,x,hfktmonom);\n return cf*procname(tm,y) \n else\n if type(y,`+`) then \n return map2(procname,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(type,y,hfktmonom) ;\n return cf*procname(x,tm)\n else\n innerH_mon(x,y);\n \+ end if;\n end if;\nend proc:\n#################################### ###################################################\n#\n# inner is the inner product on Schur functions. It establishes the tensor product\n # of S_n representations in terms of their characters under the Fro benius \n# characteristic map.\n#\ninner_mon := proc(sfkt1,sfkt2)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All right s reserved.`; \n local n1,n2,prt,mat,i,k,lst1,lst2;\n lst1:=[op(sfkt 1)];\n lst2:=[op(sfkt2)];\n n1:=`+`(op(lst1));\n n2:=`+`(op(lst2)); \n if n1<>n2 then return 0 end if;\n if op(sfkt1)=0 and op(sfkt2)=0 \+ then return s[0] end if;\n prt:=PartNM(n1,n1);\n n2:=nops(prt);\n m at:=matrix(n2,n2,(i,j)->MurNak(prt[j],prt[i]));\n # -- find position o f lst1, and lst2 in prt\n i:=1:while prt[i]<>lst1 do i:=i+1; end do; \n k:=1:while prt[k]<>lst2 do k:=k+1; end do;\n # -- use the characte rs to generate the multp. table\n add(add(\n zee(prt[l])^(-1)*mat[ i,l]*mat[k,l]*mat[m,l]*s[op(prt[m])]\n ,l=1..nops(prt)),m=1..n2); \nend proc:\n#\n#\ninner:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2,y,f;\n if nargs=1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 then return procna me(procname(x,y),args[3..-1]) end if;\n if not(type(x,sfktpolynom) an d type(args[2],sfktpolynom)) then error \"wrong type\\n\" end if;\n i f type(x,`+`) then \n return map(procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return cf*proc name(tm,y)\n else\n if type(y,`+`) then \n return map2(procna me,x,y);\n elif type(y,`*`) then\n tm,cf:=selectremove(type,y, sfktmonom);\n return cf*procname(x,tm)\n else\n if x=0 or y=0 then return 0 end if;\n inner_mon(x,y)\n end if;\n end i f;\nend proc:\n#\n# cinner_mon is the inner coproduct on monomials, it is the Schur-Hall dual of \n# the inner product of Schur f unctions and is computed by using that\n# particular fact. \n#\ncinner_mon:=proc(sfkt)\n option `Copyright (c) B. Fauser & R. Ab lamowicz 2003-2008. All rights reserved.`; \n local n1,n2,prt,lst;\n \+ if sfkt=0 then return 0 end if;\n lst:=[op(sfkt)];\n if sfkt=s[0] t hen return &t(s[0],s[0]) end if;\n n1:=`+`(op(lst));\n prt:=SchurFkt :-PartNM(n1,n1);\n add(&t(s[op(i)],inner(s[op(i)],s[op(lst)])),i=prt) ;\nend proc:\n#\n# cinner is the linear version of cinner_mon\n#\ncinn er:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-20 08. All rights reserved.`,\n remember;\n local cf,tm,n1,plst1,plst2, i;\n if type(x,`+`) then \n return map(procname,x,y);\n elif type (x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n return \+ cf*procname(tm,y)\n else\n cinner_mon(x); \n end if;\nend proc: \n#\n# counitInnerS computes the counit of the inner coporduct in the \n# Schur function basis\n#\ncounitInnerS:=proc(x)\n option `C opyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved. `,\n remember;\n local cf,tm;\n if type(x,`+`) then \n return ma p(procname,x,serName);\n elif type(x,`*`) then \n tm,cf:=selectrem ove(type,x,sfktmonom);\n return cf*procname(tm,serName)\n else\n \+ subs(s[0]=1,Scalar(x,s[`+`(op(x))]));\n end if;\nend proc:\n#\n# in nerP_mon computer the inner product of power sum functions. \n#\ninner P_mon := proc(pfkt1,pfkt2)\n option `Copyright (c) B. Fauser & R. Abl amowicz 2003-2008. All rights reserved.`; \n local n1,n2,bool,lst1,ls t2;\n n1:=`+`(op(pfkt1));\n n2:=`+`(op(pfkt2));\n if n1<>n2 then re turn 0 end if;\n bool:=map(x->if x=0 then true else false end if,zip( (x,y)->x-y,[op(pfkt1)],[op(pfkt2)]));\n if convert(bool,set)=\{true\} then\n return zee([op(pfkt1)])*pfkt1;\n else \n return 0;\n e nd if; \nend proc:\n#\n# innerP is the multilinear version of the inne r product in power sum basis\n#\ninnerP:=proc(x)\n option `Copyright \+ (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n rem ember;\n local cf,tm,p1,p2,y,f;\n if nargs=1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if;\n if nargs>2 the n return procname(procname(x,y),args[3..-1]) end if;\n if not(type(x, pfktpolynom) and type(args[2],pfktpolynom)) then error \"wrong type\\n \" end if;\n if type(x,`+`) then \n return map(procname,x,y);\n e lif type(x,`*`) then \n tm,cf:=selectremove(type,x,pfktmonom);\n \+ return cf*procname(tm,y)\n else\n if type(y,`+`) then \n ret urn map2(procname,x,y);\n elif type(y,`*`) then\n tm,cf:=selec tremove(type,y,pfktmonom);\n return cf*procname(x,tm)\n else\n innerP_mon(x,y);\n end if;\n end if;\nend proc:\n#\n# cinner P_mon computes the inner coproduct on monomials in the power sum\n# \+ basis, this coproduct is grouplike on all basis elements\n# \+ x |--> &t(x,x) \n#\ncinnerP_mon:=proc(x)\n &t(x,x);\nend proc:\n#\n# cinnerP linear version of the inner coproduct in the powe r sum basis\n#\n#\ncinnerP:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n loc al cf,tm;\n if type(x,`+`) then \n return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n re turn cf*procname(tm)\n else\n cinnerP_mon(x);\n end if;\nend proc :\n#\n# cinnerP linear version of the inner coproduct in the power sum basis\n#\n#\ncounitInnerP:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n loc al cf,tm;\n if type(x,`+`) then \n return map(procname,x);\n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom);\n re turn cf*procname(tm)\n else\n return 1;\n end if;\nend proc:\n\n \n#################################################################### ################\n#\n# Plethysms\n#\n################################# ###################################################\n#\n# list_divisor s(n::posint) -> a list of all natrural numbers which divide n \n#\nlis t_divisors:=proc(x)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`; \n local i,t,res;\n if x=1 then r eturn [1] end if;\n res:=[];\n for i from 1 to floor(x/2) do\n t: =irem(x,i);\n if t = 0 then\n res:=[op(res),i];\n end if;\n end do; \n [op(res),x];\nend:\n################################### #################################################\n#\n# plethysm copro duct of a single part power sum \n#\n################################# ###################################################\nplethPsingleP:=pr oc(pfkt)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008 . All rights reserved.`; \n local part,ld;\n part:=[op(pfkt)];\n \+ ld:=list_divisors(op(part));\n add(&t(p[i],p[op(part)/i]),i=ld);\ne nd proc:\n#\n# plethP_mon computes the plethysm between two power sum \+ basis monoms. We have\n# -- p_0[p\\mu]=p[0]\n# -- p_\\mu[p _0]=p_0\n# -- p_n[p_m]=p_n.m\n# -- p_m[p_mu]=p_\\mu[p_n] a nd hence\n# -- p_\\mu[p_\\nu] = \\prod_(i,j) p_[\\mu_i.\\nu_j]\n #\n# NOTE: THIS VERSION SEEMS TO BE SLOWER THAN THE BELOW GIVEN BY A F ACTOR 1.5\n#\n#plethP_mon:=proc(x,y)\n# option `Copyright (c) B. Faus er & R. Ablamowicz 2003-2008. All rights reserved.`,\n# rememb er;\n# local p1,p2;\n# p1,p2:=[op(x)],[op(y)];\n# if p1=[0] or p2=[ 0] then return p[0] end if;\n# if nops(p1)=1 then\n# if nops(p2)=1 then\n# return p[op(p1)*op(p2)]\n# else\n# return p[op (map(x->op(p1)*x,p2))]\n# end if\n# else\n# outerP(seq(procname (p[l],y),l in p1));\n# end if;\n#end proc:\n######################### #########################################################\n# plethP_mo n is the plethysm product on power sum symmetric monomial functions\n# -- nonrecursive version\n#\n#\nplethP_mon:=proc(pfkt1,pfkt2)\n opt ion `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights res erved.`;\n local part1,part2;\n part1:=[op(pfkt1)];\n part2:=[op(pf kt2)];\n p[op(sort(\n [seq(seq(part1[i]*part2[j],i=1..nops (part1)),j=1..nops(part2))],\n (i,j)->if i>j then true else fa lse end if\n ))];\nend proc:\n#\n# plethysm of power sum pol ynomials ...\n#\n# plethP(P,Q) = P[Q]\n# -- linear in P (P1+P2)[Q]= P1[Q]+P2[Q]\n# -- not linear in Q, that is\n# -- P[Q1+Q2]=P_(1)[Q1]. P_(2)[Q2] where \\Delta(P)=P_(1) \\otimes P_(2) is the outer coproduc t\n# -- P[Q1.Q2]=P_[1][Q1].P_[2][Q2] where \\delta(P)=P_[1] \\otimes P_[2] is the inner corpoduct\n# (th is case is trated in plethP_mon\n# -- P[-Q]=(antipP(P))[Q] h ence we need to split Q in to a positive and negative\n# \+ part\n#\nplethP:=proc(x,y)\n option `Copyright ( c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local cf,term,term2,cout,sgn,f,a,b;\n if type(x,pfktm onom) then\n if x=p[0] then return p[0] end if;\n if x=p[1] then return y end if;\n if type(y,pfktmonom) then\n if y=p[0] then return p[0] end if;\n if y=p[1] then return x end if;\n ret urn plethP_mon(x,y)\n elif type(y,`*`) then\n# -- note that cf*ter m = term+term+...+term is the additive case!!\n term,cf:=selectre move(type,y,pfktmonom);\n if type(cf,integer) then\n if cf <0 then\n return (-1)^nops([op(x)])*procname(x,-cf*term);\n \+ end if;\n# -- put a bracket [cf-1] to prevent linear expansion \+ in the tensor &t(...)\n cout:=&t(couterP(x),[cf-1],term); \n \+ f:=(u,v,c,t)->outerP(plethP(u,t),plethP(v,op(c)*t));\n ret urn eval(subs(`&t`=f,cout));\n else\n error(\"2nd argument need to be a polynomial over the integers but received: %1\\n\",y);\n end if;\n else\n cout:=[op(y)];\n a,b:=cout[1],cout [2..-1];\n cout:=&t(couterP(x),[a],b);\n f:=(u,v,c,t)->outer P(plethP(u,op(c)),plethP(v,`+`(op(t)))):\n return eval(subs(`& t`=f,cout)); \n end if;\n elif type(x,`*`) then\n term,cf:=se lectremove(type,x,pfktmonom);\n return cf*procname(term,y);\n else \n return map(procname,x,y);\n end if;\nend proc:\n" }{MPLTEXT 1 0 16090 "#\n# cplethP is the plethystic coproduct on power sum functio ns\n#\n#\ncplethP:=proc(pfkt)\n option `Copyright (c) B. Fauser & R. \+ Ablamowicz 2003-2008. All rights reserved.`;\n local cf,term,llst,dls t,res,i,Npi,pi,dPi;\n##\n if type(pfkt,`+`) then \n return map(pro cname,pfkt)\n elif type(pfkt,`*`) then\n term,cf:=selectremove(typ e,pfkt,pfktmonom);\n return cf*procname(term)\n else\n ######\n \+ pi:=[op(pfkt)];\n Npi:=`+`(op(pi));\n dPi:=list_divisors(Npi); \n res:=0;\n for i in dPi do\n llst:=PartNM(i,i);\n \+ dlst:=PartNM(Npi/i,Npi/i);\n res:=res+\n add(add(\n \+ 1/(zee(l)*zee(d))\n *ScalarP(p[op(pi)],plethP(p[op(l )],p[op(d)]))*&t(p[op(l)],p[op(d)])\n ,l=llst),d=dlst);\n \+ end do;\n res;\n ######\n end if; \nend proc:\n################ #################################################################\n#\n # SFunction PLETHYSMS\n#\n######################################### ########################################\n#\n# plethysm of two complet e symmetric functions aka s[n],s[m]\n#\n# -- we use the notation P[Q ]=pleth(P,Q), hence the plethysm is linear in P (first variable)\n# \+ -- the plethysm is not linear in the second variable Q, it distributes with the inner\n# -- coproduct over the the second argument:\n# - - P[Q1.Q2]=P_\{[1]\}[Q1].P_\{[2]\}[Q2]\n# -- if P is given in a powe r sum basis, then \\delta P = P_[1]\\otimes P_[2] = P \\otimes P\n#\n# +++ plethsp(sfkt,pfkt) -> sfkt\n# -- this function is base d on the transition s_to_p and the power sum plethysm\n# -- \+ of pfktmonomials, followed by a transformation back into sfunctions!\n # -- plethP_mon computes pfktmonom[pfktmonom] plethysms \n# \+ -- Since x=s[n] is a one row sfkt (complete function), the c haracters in the\n# -- expansions are all 1 and dissapear fr om the computation.\n#\nplethsp:=proc(x,y)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember; \n local n;\n n:=op(x);\n p_to_s(add(1/zee(i)*plethP(y,p[op(i)]),i \+ in PartNM(n,n)));\nend proc:\n#\n# +++ plethSnm(sfkt,sfkt) -> sfkt\n# \+ -- this function expands the outer one row Sfunction into power \+ sums (without\n# -- characters as in plethsp above) and uses aft erwards the fact that \n# -- p_n[Q] = Q[p_n] for one part (primi tive) power sum functions. The remaining\n# -- plethysms are of \+ the form s_n[p_k] which can be computed via the function\n# -- p lethsp defined above.\n# -- This function does not make use of a possible cancellation of terms due\n# -- to the finiteness of d imenions (the alphabet involved)\n# -- This function is by fare \+ not optimal (see Axel Kohnert's algorithm)\n#\nplethSnm:=proc(x,y)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights \+ reserved.`,\n remember;\n local n,m;\n n,m:=op(x),op(y);\n if n=0 \+ then \n return s[0]\n elif m=0 then \n return s[0]\n elif n=1 \+ then\n return y\n elif m=1 then \n return x\n end if; \n add( 1/zee(i)*outer(op(map((k)->plethsp(s[m],p[k]),[op(i)]))) ,i in PartNM( n,n));\nend proc:\n#\n# plethSP: sfkt x pfkt --> sfkt\n# +++ plethSP realized the pletysm of an Sfucntion monom by a pfktmonom for general \n# -- partitions \\lambda,\\mu. This time we need to insert the ch aracters of the\n# -- s_to_p transition computed via the Murnaghan \+ Nakayama rule.\n#\n# ++ plethSP shows that\n# ++ plethSP(s[n],p[ 0]) = s[0]\n# ++ plethSP(s[lambda],p[0]) = 0 for \\length(lambda)> 1\n#\nplethSP:=proc(x,y)\n option `Copyright (c) B. Fauser & R. Ablam owicz 2003-2008. All rights reserved.`,\n remember;\n local n;\n n: =`+`(op(x));\n p_to_s(add(1/zee(i)*MurNak(i,[op(x)])*plethP(y,p[op(i) ]),i in PartNM(n,n)));\nend proc:\n#\n#\n# plethS_mon : sfkt x sfkt -- > sfkt\n# +++ plethS_mon computes the pletysm of two SFunction monoms. It uses the expansion \n# -- s_to_p and thereby the Murnaghan Nakaya ma coefficients. The second step is once \n# -- more to use p_n[s_\\l ambda] = s_\\lambda[p_n] and compute these plethysms via\n# -- plethS P\n#\nplethS_mon:=proc(x,y)\n option `Copyright (c) B. Fauser & R. Ab lamowicz 2003-2008. All rights reserved.`,\n remember;\n loca l n,m;\n n,m:=`+`(op(x)),`+`(op(y));\n if n=0 then \n return s[0] \n elif m=0 then\n # -- according to SCHUR (and plethSP see above) \n # -- plethS(s[n],s[0]) = s[0]\n # -- plethS(s[lambda],s[0]) = 0 if length(lambda)>1\n if nops([op(x)]) > 1 then \n return \+ 0\n else\n return s[0]\n end if;\n elif n=1 then\n retu rn y\n elif m=1 then \n return x\n end if; \n add(1/zee(i)*MurNa k(i,[op(x)])*outer(op(map((k)->plethSP(y,p[k]),[op(i)]))) ,i in PartNM (n,n));\nend proc:\n#\n# X[Y] is linear in X and not linear in Y\n# \+ -- (X+Y)[Z] = X[Z] + Y[Z]\n# -- X[Y+Z] = X(1)[Y] . X(2)[Z] where . \+ = outer, couter(X)=X(1) x X(2)\n# -- X[YZ] = X[1] . X[2] where . = o uter, cinner(X) =X[1] x X[2]\n# -- this case does not appear \+ in the function, since unevaluated\n# -- outer products YZ do not appear.\n#\nplethS:=proc(x,y)\n option `Copyright (c) B. Fauser \+ & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember; \n local cf,tm,p1,p2,a,b,f;\n# ++ special cases\n# -- one argument nu merical zero\n if x=0 then \n return 0\n elif y=0 then \n re turn 0\n end if;\n# ++ typecheck\n if not(type(x,sfktpolynom) and ty pe(args[2],sfktpolynom)) then \n error \"wrong type\\n\" \n end i f;\n if x=s[0] then \n #-- s_(0)[s_(lambda)] = s_(0) for all lambda \n return s[0]\n # -- the case y=s[0] needs a more sophisticated t reatment\n # -- which is done in plethS_mon\n# ++ s[1] is left and ri ght unit of plethS\n elif x=s[1] then\n return y\n elif y=s[1] th en\n return x\n end if;\n## -- end of special cases\n## -- plethS \+ is linear in x but _not_ linear in y\n# ++ linearity in x \n if type( x,`+`) then \n return map(procname,x,y);\n elif type(x,`*`) then \+ \n tm,cf:=selectremove(type,x,sfktmonom);\n return cf*procname(t m,y)\n else\n## -- the y argument distributes using coproducts\n## -- outer roducts do not happen, so we need to distinguish\n## -- two typ es of additive terms y = a+b and y = a+a = 2a\n## -- different terms h ave type `+`\n if type(y,`+`) then \n b:=[op(y)];\n a:=&t (couter(x),[b[1]],b[2..-1]);\n##////////print(x,[y],a);\n f:=(x_, y_,a_,b_)->outer(plethS(x_,op(a_)),plethS(y_,`+`(op(b_))));\n ret urn eval(subs(`&t`=f,a));\n## -- numerical multiples of the same term \n elif type(y,`*`) then\n tm,cf:=selectremove(type,y,sfktmono m);\n##////////print(x,[cf,tm]);\n if not type(cf,integer) then \+ \n error \"Second input must be a polynomial over the integers , but received \",y; \n end if;\n if cf>0 then\n a:=& t(couter(x),tm,[cf-1]);\n f:=(x_,y_,a_,b_)->outer(plethS_mon(x_ ,a_),plethS(y_,op(b_)*a_));\n return eval(subs(`&t`=f,a));\n \+ else\n return procname(antipS(x),-y);\n end if;\n el se\n## ++ if neither x nor y has type `+` or `*` then we have tow sfkt monomials \n plethS_mon(x,y)\n end if;\n end if;\nend proc:\n ###################################################################### #####\n#\n# cplethS_mon is the plethysm coproduct of a sfktmonom\n# \+ -- the plethysm coproduct is obtained by dualizing the plethysm opera tion w.r.t\n# -- the Schur-Hall scalar product:\n# -- cplethS(x) = \\sum_(y,z) < x ,plethS(y,z) > (y &t z)\n# -- where <,> is teh \+ scalar product and plethS is the pelthysm of sfunctions\n# -- note \+ that this is a noncocommutative operation and the order of y,z matters .\n#\ncplethS_mon:=proc(x)\n local n,divx,prta,prtb;\n n:=`+`(op(x)) ;\n divx:=list_divisors(n);\n add(add(add(\n eval(subs(s[0]=1,Sc alar(x,plethS(s[op(a)],s[op(b)]))))*&t(s[op(a)],s[op(b)]), \n b in \+ PartNM(n/i,n/i)), a in PartNM(i,i)), i in divx);\nend proc:\n#\n# cple thS is the linear version of cplethS_mon establishing the plethysm cop roduct of \n# -- SFunctions. \n#\n#\ncplethS:=proc(x)\n option `C opyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved. `,\n remember;\n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) the n \n return map(procname,x,y);\n elif type(x,`*`) then \n tm,cf :=selectremove(type,x,sfktmonom);\n return cf*procname(tm,y)\n els e\n if type(y,`+`) then \n return map2(procname,x,y);\n eli f type(y,`*`) then\n tm,cf:=selectremove(type,y,sfktmonom);\n \+ return cf*procname(x,tm)\n else\n if x=s[0] then return &t(s [0],s[0]) end if;\n cplethS_mon(x); \n end if;\n end if;\nen d proc:\n############################################################# ##############\n#\n#\n#########\n######### Orthogonal Hopf algebra\n## #######\n#\n# outerON_monom outer product on s-function monoms of the \+ orthogonal group\n#\n#\nouterON_monom:=proc(x,y)\n option `Copyright \+ (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n loc al N,prt;\n N:=min(`+`(op(x)),`+`(op(y)));\n prt:=[s[0],op(map(x->s[ op(x)],[seq(op(PartNM(i,i)),i=1..N)]))];\n add(outer(skew(x,s[op(i)]) ,skew(y,s[op(i)])),i=prt);\nend proc:\n#\n# outerON outer product of s -function polynoms fro orthogonal groups\n#\n#\n#\nouterON:=proc(x)\n \+ option `Copyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n remember;\n local cf,tm,p1,p2,y,f;\n if nargs=1 then return x end if;\n y:=args[2];\n if x=0 or y=0 then return 0 end if ;\n if nargs>2 then return procname(procname(x,y),args[3..-1]) end if ;\n if not(type(x,sfktpolynom) and type(args[2],sfktpolynom)) then er ror \"wrong type\\n\" end if;\n if type(x,`+`) then \n return map( procname,x,y);\n elif type(x,`*`) then \n tm,cf:=selectremove(type ,x,sfktmonom);\n return cf*procname(tm,y)\n else\n if type(y,`+ `) then \n return map2(procname,x,y);\n elif type(y,`*`) then \n tm,cf:=selectremove(type,y,sfktmonom);\n return cf*procna me(x,tm)\n else\n outerON_monom(x,y);\n end if;\n end if; \nend proc:\n#\n# couterON_monom outer coproduct of s-function monoms \+ for the orthogonal groups \n#\n#\ncouterON_monom:=proc(x)\n option `C opyright (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved. `;\n local prt, del;\n prt:=[[0],seq(op(PartNM(i,i)),i=1..`+`(op(x)) )];\n del:=map(x->2*x,[[0],seq(op(PartNM(i,i)),i=1..floor(`+`(op(x))) /2)]);\n add(&t(skew(x,outer(add(s[op(k)],k=del),s[op(i)])),s[op(i)]) ,i=prt); \nend proc:\n#\n# couterON outer coproduct of sfunction polyn oms for the orthogonal groups \n#\ncouterON:=proc(x)\n option `Copyri ght (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`,\n \+ remember;\n local cf,tm,n1,plst1,plst2,i;\n if type(x,`+`) t hen \n return map(procname,x,y);\n elif type(x,`*`) then \n tm, cf:=selectremove(type,x,sfktmonom);\n return cf*procname(tm,y)\n e lse\n couterON_monom(x); \n end if;\nend proc:\n################# ###################################################################### #\n##\n## S-function Series facilities\n##\n########################## ##############################################################\n#\n# \+ getSfktSeries returns a sum of S-functions of a known Schur function s eries\n#\n# -- currently known series are M,L,D,B,F\n#\ngetSfktSeries :=proc(name)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2003- 2008. All rights reserved.`,\n remember;\n local N,prt,serF lag,t,f;\n if nargs=1 then\n if args[1]='names' then \n \+ return \"Known Series are: A,B,C,D,E,F,L,M\";\n else\n err or \"Usage: either give one argument 'names' or [2|3] arguments, see h elp page\";\n end if;\n end if; \n if nargs>=2 then N:=args[2 ] end if;\n if nargs=3 then serFlag:=true; t:=args[3] else serFlag:= false end if;\n ## ///////////////////////////\n ## M-series = \\s um \{m\} t^m\n ##\n if name='M' then\n if serFlag=false then \n return [seq(s[m],m=0..N)];\n else\n add(s[m]*t ^m,m=0..N);\n end if;\n ## ///////////////////////////\n ## L -series = \\sum (-1)^m \{1^m\} t^m\n ##\n ## (special care for zer o partition)\n ##\n elif name='L' then\n if serFlag=false the n\n return [seq((-1)^m*s[m],m=0..N)];\n else\n f: =m->if m=0 then 0 else 1$m end if:\n add((-1)^m*s[f(m)]*t^m,m= 0..N);\n end if;\n ## ///////////////////////////\n ## C-seri es = \\sum \{\} (inverse of the D series)\n ##\n ## (we scale the \+ parameter t also!)\n elif name='C' then\n prt:=[s[0],op(\n \+ map(x->if \{1\}=\{op(zip((i,j)->i-j,op(part2Frob([op(x)])))) \} then \n (-1)^(`+`(op(x))/2)*x else NULL end if,p rocname(F,N)) )];\n if serFlag=false then\n return prt; \n else\n ## --- take care of the sign\n f:=proc(x, t)\n local cf,term;\n cf:=1:\n if type(x ,`*`) then\n term,cf:=selectremove(type,x,sfktmonom);\n \+ return (cf*t)^(`+`(op(term)))\n else\n \+ return (cf*t)^(`+`(op(x)))\n end if;\n end proc:\n \+ ## --- \n add(i*f(i,t),i=prt);\n end if;\n ## ///////////////////////////\n ## D-series = \\sum \{delta\} \+ delta=even parts only\n ##\n ## (we scale the parameter t also!)\n elif name='D' then\n prt:=map(x->2*x,[[0],seq(op(PartNM(i,i)), i=1..floor(N/2))]);\n if serFlag=false then\n return map( x->s[op(x)],prt);\n else\n add(s[op(i)]*t^(`+`(op(i))),i= prt);\n end if;\n ## /////////////////////////// \n ## B-se ries = \\sum \{beta\} conjpart(beta)=even parts only\n ##\n ## ( we scale the parameter t also!)\n elif name='B' then\n prt:=map (x->2*x,[[0],seq(op(PartNM(i,i)),i=1..floor(N/2))]);\n prt:=map(x ->conjpart(x),prt);\n if serFlag=false then\n return map( x->s[op(x)],prt);\n else\n add(s[op(i)]*t^(`+`(op(i))),i= prt);\n end if;\n ## ///////////////////////////\n ## A-serie s \n ##\n elif name='A' then \n prt:=[s[0],op(\n \+ map(x->if \{1\}=\{op(zip((i,j)->j-i,op(part2Frob([op(x)]))))\} then \+ \n (-1)^(`+`(op(x))/2)*x else NULL end if,procname( F,N)) )];\n if serFlag=false then\n return prt;\n e lse\n ## --- take care of the sign\n f:=proc(x,t)\n \+ local cf,term;\n cf:=1:\n if type(x,`*`) the n\n term,cf:=selectremove(type,x,sfktmonom);\n \+ return (cf*t)^(`+`(op(term)))\n else\n return ( cf*t)^(`+`(op(x)))\n end if;\n end proc:\n # # --- \n add(i*f(i,t),i=prt);\n end if;\n ## /// ////////////////////////\n ## E-series = \\sum_self conj part (-)^( |x|+r) *s[prt]\n ## r = Frobenius rank of the partition \n ##\n elif name='E' then \n prt:=[s[0],op(\n m ap(x->if \{0\}=\{op(zip((i,j)->j-i,op(part2Frob([op(x)]))))\} then \n \+ x else NULL end if,procname(F,N)) )];\n if s erFlag=false then\n return map(x->(-1)^((`+`(op(x))+nops(part2 Frob([op(x)])[1]))/2)*x ,prt);\n else\n add((-1)^((`+`(op (i))+nops(part2Frob([op(i)])[1]))/2)*i\n *t^(`+`(op(i))),i =prt);\n end if;\n ## ///////////////////////////\n ## F-seri es = \\sum \{zeta\} all partitions \n ##\n elif name='F' then\n \+ prt:=[[0],seq(op(PartNM(i,i)),i=1..N)];\n if serFlag=false th en\n return map(x->s[op(x)],prt);\n else\n add(s[ op(i)]*t^(`+`(op(i))),i=prt);\n end if;\n else\n error \" unrecognized series name\";\n end if;\nend proc:\n#\n# branch_monom \+ internal function for branchings on monoms\n#\n# +++ !!!! this functio n should be already multilinear !!!!\n# +++ remove branch and rename t his one after a test!\nbranch_monom:=proc(x,serName)\n option `Copyr ight (c) B. Fauser & R. Ablamowicz 2003-2008. All rights reserved.`;\n local ser;\n ser:=getSeries(serName,`+`(op(x)),1);\n skew(x,ser); \nend proc:\n#\n# branch computes the reduction of induction of charac ters with respect to\n# certain S-function series\n#\nbranch:=p roc(x,serName)\n option `Copyright (c) B. Fauser & R. Ablamowicz 2004 -2006. All rights reserved.`,\n remember;\n local ser,cf,tm,n1,plst1 ,plst2,i;\n if type(x,`+`) then \n return map(procname,x,serName); \n elif type(x,`*`) then \n tm,cf:=selectremove(type,x,sfktmonom); \n return cf*procname(tm,serName)\n else\n ser:=SchurFkt:-getSf ktSeries(serName,`+`(op(x)),1);\n skew(x,ser); \n end if;\nend pr oc:\n\n" }{MPLTEXT 1 281 14 "end module:\n##" }}{PARA 6 "" 1 "" {TEXT -1 41 "SchurFkt Version 1.0.1 says 'Good bye...'" }}{PARA 6 "" 1 "" {TEXT -1 41 "SchurFkt Version 1.0.2 says 'Good bye...'" }}{PARA 6 "" 1 "" {TEXT -1 52 "SchurFkt Version 1.0.1 (17 xii 2007) at your service " }}{PARA 6 "" 1 "" {TEXT -1 58 "(c) 2003-2008 BF&RA, no warranty, no \+ fitness for anything!" }}{PARA 6 "" 1 "" {TEXT -1 83 "Increase verbosi ty by infolevel[`function`]=val -- use online help > ?Bigebra[help]" } }}{EXCHG {PARA 337 "> " 0 "" {MPLTEXT 1 283 29 "libname;\nsavelib('Sch urFkt');" }}{PARA 11 "" 1 "" {XPPMATH 20 "6&Q7C:\\Maple11/Cliffordlib6 \"Q/C:\\Maple11/libF$Q4C:\\Brachey.Troy/TNBF$QAC:\\Maple11/SINGULARPLU RALlinklibF$" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 "restart:res tart:" }}{PARA 6 "" 1 "" {TEXT -1 41 "SchurFkt Version 1.0.2 says 'Goo d bye...'" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 "restart:with(S churFkt);nops(%);" }}{PARA 6 "" 1 "" {TEXT -1 50 "SchurFkt Version 1.0 .2 (9 vi 2008) at your service" }}{PARA 6 "" 1 "" {TEXT -1 58 "(c) 200 3-2008 BF&RA, no warranty, no fitness for anything!" }}{PARA 6 "" 1 " " {TEXT -1 83 "Increase verbosity by infolevel[`function`]=val -- use \+ online help > ?Bigebra[help]" }}{PARA 12 "" 1 "" {XPPMATH 20 "6#7_p%)A lexCompG%)CharHookG%'CompNMG%%FLATG%*Frob2partG%-GesselThetaPG%-Gessel ThetaSG%)KostkaPCG%,KostkaTableG%)LaplaceMG%-LaplaceM_monG%-LaplaceTab leG%%MLING%'MurNakG%(MurNak2G%'PartNMG%'ScalarG%)ScalarHMG%)ScalarMHG% (ScalarPG%'antipEG%'antipHG%'antipMG%(antipMCG%'antipPG%'antipSG%'bran chG%'cinnerG%(cinnerPG%)cmp2partG%,cmp2prtMultG%(concatMG%)conjpartG%- counitInnerPG%-counitInnerSG%'couterG%(couterEG%(couterHG%(couterMG%)c outerONG%(couterPG%(cplethPG%(cplethSG%&dimSNG%'e_to_hG%'e_to_sG%6eval JacobiTrudiMatrixG%.getSfktSeriesG%+grAlexCompG%'h_to_mG%'h_to_sG%&inn erG%'innerHG%'innerPG%*isLatticeG%'m_to_pG%0maxlengthSymFktG%*mset2par tG%&outerG%'outerEG%'outerHG%'outerMG%(outerONG%'outerPG%'outerSG%'p_t o_mG%'p_to_sG%*part2FrobG%*part2msetG%'plethPG%'plethSG%)plethSnmG%'s_ to_hG%)s_to_hJTG%*s_to_hmatG%'s_to_pG%'s_to_xG%%skewG%)sq_coeffG%)trun cLENG%(truncWTG%'x_to_sG%$zeeG" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#\"#$ )" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 "KostkaTable(4);" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#/%(Kostka4GK%'matrixG6#7'7'\"\"\"F*F*F *F*7'\"\"!F*F*\"\"#\"\"$7'F,F,F*F*F-7'F,F,F,F*F.7'F,F,F,F,F*Q(pprint06 \"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "LaplaceTable(4,6);" } }{PARA 11 "" 1 "" {XPPMATH 20 "6#K%'matrixG6#7(7.%&G7#\"\"'7$\" \"&\"\"\"7$\"\"%\"\"#7%F/F-F-7$\"\"$F37%F3F0F-7&F3F-F-F-7%F0F0F07&F0F0 F-F-7'F0F-F-F-F-7(F-F-F-F-F-F-7.7#F/&%\"mG6#\"#5\"\"!F@F@F@F@F@F@F@F@F @7.7$F3F-F@,&&F=6$\"\")F0F-&F=6$F*F/F-,&&F=6$\"\"(F3F-*&F0F-&F=6$F,F,F -F-F@FGF@F@F@F@F@F@7.7$F0F0F@FJFGF@FNF@F@F@F@F@F@7.7%F0F-F-F@F@F@,&&F= 6%F*F0F0F-&F=6%F,F3F0