{VERSION 4 0 "IBM INTEL NT" "4.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" 0 21 "" 0 1 0 0 0 1 0 0 0 0 2 0 0 0 0 1 }{CSTYLE "" -1 256 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 257 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 258 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 259 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 260 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 261 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 262 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 263 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 264 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 265 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 266 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 267 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 268 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 269 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 270 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 271 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 272 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 273 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 274 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 275 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 276 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 277 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 278 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 279 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 280 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 281 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 282 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 283 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 284 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 285 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 286 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 287 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 288 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 289 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 290 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 291 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 292 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 293 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 294 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 295 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 296 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 297 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 298 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 299 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 300 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 301 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 302 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 303 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 304 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 305 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 306 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 307 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 308 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 309 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 310 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 311 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 312 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 313 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 314 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 315 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 316 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 317 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 318 "Helvetica" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 319 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 320 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 321 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 322 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 323 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 324 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 325 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 326 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 327 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 328 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 329 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 330 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 331 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 332 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 333 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 334 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 335 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 336 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 337 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 338 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 339 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 340 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 341 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 342 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 343 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 344 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 345 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 346 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 347 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 348 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 349 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 350 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 351 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 352 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 353 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 354 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 355 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 356 "" 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 357 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 358 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 359 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 360 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 361 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 362 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 363 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 364 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 365 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 366 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 367 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 368 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 369 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 370 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 371 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 372 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 373 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 374 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 375 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 376 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 377 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 378 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 379 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 380 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 381 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 382 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 383 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 384 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 385 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 386 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 387 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 388 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 389 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 390 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 391 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 392 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 393 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 394 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 395 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 396 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 397 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 398 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 399 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 400 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 401 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 402 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 403 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 404 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 405 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 406 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 407 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 408 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 409 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 410 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 411 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 412 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 413 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 414 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 415 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 416 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 417 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 418 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 419 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 420 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 421 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 422 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 423 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 424 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 425 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 426 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 427 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 428 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 429 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 430 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 431 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 432 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 433 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 434 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 435 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 436 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 437 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 438 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 439 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 440 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 441 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 442 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 443 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 444 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 445 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 446 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 447 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 448 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 449 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 450 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 451 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 452 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 453 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 454 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 455 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 456 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 457 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 458 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 459 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 460 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 461 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 462 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 463 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 464 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 465 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 466 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 467 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 469 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 470 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 471 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 472 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 473 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 474 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 475 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 476 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 477 "" 1 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 478 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 479 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {PSTYLE "Normal" -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 1 0 1 0 2 2 0 1 }{PSTYLE "Warning" -1 7 1 {CSTYLE "" -1 -1 "Courier" 1 10 0 0 255 1 2 2 2 2 2 1 1 1 3 1 }1 1 0 0 0 0 1 0 1 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 1 0 1 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 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 255 1 2 1 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 2" -1 257 1 {CSTYLE "" -1 -1 "Times" 1 12 255 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 }{PSTYLE "Normal" -1 258 1 {CSTYLE "" -1 -1 "Helve tica" 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 258 "" 0 "" {TEXT -1 26 "\nThis is clifford6_13.m ws\n" }}{PARA 258 "" 0 "" {TEXT -1 61 "(Created: October 9, 2002)\n(La st revised: December 27, 2002)\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "################################################################ #############\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR TH E CLIFFORD, BIGEBRA, Cliplus, Octonion, GTP #\n#PACKAGES TO THE EX TENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE #\n# PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IM PLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ME RCHANTABILITY #\n#AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE R ISK AS TO THE QUALITY #\n#AND PERFORMANCE OF THE PROGRAM IS WITH YO U. SHOULD THE PROGRAM PROVE #\n#DEFECTIVE, YOU ASSUME THE COST O F ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n############### ##############################################################\n" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 322 "This is a listing (without examples) of all procedures in a Maple package \+ called 'CLIFFORD' (Version 6, Copyright 1995-2003 by Rafal Ablamowic z, Tennessee Technological University), and Bertfried Fauser, Univers it\"at Konstanz, for Maple 6. User will know which version he/she is u sing by using the 'version()' function." }}{PARA 0 "" 0 "" {TEXT -1 258 "\nThe following new procedures have been added on October 20, 200 2:\n\nrd_basmonom - generates a random Grassmann basis monomial \nrd_monom - generates a random Grassmann monomial \nrd_c lipolynom - generates a random Grassmann polynomial \n" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use index such as K or -K:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 66 "cmul[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) " }}{PARA 0 "" 0 "" {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Clifford produ ct of p1,p2,...,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in \+ Cl(K) (here K is expected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 126 "&cQ[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is expected to be a diagonal matrix), ampersand form " }}{PARA 0 "" 0 "" {TEXT -1 56 "cexp[K](p,N); ## exponential of p in \+ Cl(K) up to order N" }}{PARA 0 "" 0 "" {TEXT -1 102 "cexpQ[K](p,N); ## exponential of p in Cl(K) up to order N (here K is expected to be a d iagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## m inimal polynomial of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K ](p,N); ## exponential of p in Cl(K) up to order N modulo the minimal \+ polynomial of p" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 278 96 "The following procedures can use name K or a numeric mul tiple of a name as an optional argument:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 106 "LC(p1,p2,K); ##left contraction o f p2 by p1 w.r.t. K\nRC(p1,p2,K); ##right contraction of p1 by p2 w.r. t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (num eric) product of m1 and m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "re version(p,K); ##reversion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Clifford inverse of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p2,K); ##left contraction of p2 by p1 w.r.t. diago nal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p1,p2,K); ##right contraction of p1 by p2 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugation(p,K); ## conjugation of p in Cl(K)" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The foll lowing procedures can pass on name or a numeric multiple of a name via a list:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 121 "type([p,K],nilpotent); ## checks if p is nilpotent in Cl(K)\ntype ([p,K],idempotent); ## checks if p is idempotent in Cl(K)" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 580 "\nProcedur es that define types: `type/climon`, `type/clipolynom`, `type/climatri x` as well as other procedures such as 'reorder', 'wedge', etc., have \+ been substantially revised to improve efficiency and speed of the pack age. This work has been done together with Bertfried Fauser, Universit \"at Konstanz, in Cookeville on October 5, 2001. \n\nThis version incl udes \"Bigebra\" package that has been created together with Bertfried Fauser, Universit\"at Konstanz, Konstanz, Germany. Additional help pa ges have been written and added to the database that explain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 150 "An additional feature in this version is an ability to display and change environmental variables. They can be displayed with procedure CLIFFORD_ENV.\n" }}{PARA 258 "" 0 "" {TEXT -1 387 "NOTE: Big change from version 4 is that now types clibas mon, climon, and clipolynom are all exclusive whereas in version 4 the y were inclusive, that is, `type/clipolynom` included `type/climon` wh ich in turn included `type/clibasmon`. \n\nThis package is made to run under Maple 6. It is available on a server of the Department of Mat hematics, Tennessee Technological University, at: \n" }}{PARA 258 " " 0 "" {TEXT -1 69 " http://math.tntech.ed u/rafal/clifford/ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 130 "In order to create a Maple file 'Clifford.m' contai ning the 'CLIFFORD' package, execute this worksheet.\n\nTo load the pa ckage type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">with(Clifford); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been \+ loaded because a list with Clifford procedures will be displayed on th e screen. To check the current version of the package, at the Maple p rompt type " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 ">version( );" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 "Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 "Department of Mathematics, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 "Tennessee Technological University " }} {PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 " }}{PARA 258 "" 0 "" {TEXT -1 24 "rablamowicz@tntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-3569" }}{PARA 258 "" 0 "" {TEXT -1 23 "fax : USA (931) 372-6353" }}{PARA 0 "" 0 "" {TEXT -1 1 "\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 59 "restart:\nunprotect('Clifford','e','qi','qj',' qk','Id','w');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module ()\n###################################\nexport `&m`, Bsignature, CLIF FORD_ENV, Kfield, LC, LCQ, RC, RCQ, RHnumber, adfmatrix, all_sigs, bet a_minus, beta_plus, buildm, bygrade, c_conjug, cbasis, cdfmatrix, cexp , cexpQ, cinv, clibilinear, clicollect, clidata, clilinear, climinpoly , cliparse, cliremove, clisolve, clisort, cliterms, cmul, cmulNUM, cmu lQ, cmulRS, cmulgen, cocycle, commutingelements, conjugation,ddfmatrix , diagonalize, displayid, extract, factoridempotent, find1str, findbas is, gradeinv, init, isVahlenmatrix, isproduct, makealiases, makeclibas mon, matKrepr, maxgrade, maxindex, mdfmatrix, minimalideal, ord, perms ign, pseudodet, q_conjug, qdisplay, qinv, qmul, qnorm, reorder, revers ion, rmulm, rot3d, scalarpart, sexp, specify_constants, spinorKbasis, \+ spinorKrepr, squaremodf, subs_clipolynom, useproduct, vectorpart, vers ion, wedge, wexp, rd_clibasmon, rd_climon, rd_clipolynom;\n########### ########################\nlocal setup;\noption package, load=setup;\n " }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'version' stores inform ation about the current version of the package. " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typical use: version( ); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1521 "version:= proc()\noptions `Copyright (c) 1995-2003 by Rafal Ab lamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `La st revised: November 1, 2002`;\nprint(`+++++++++++++++++++++++++++++++ ++++++++++++`);\nprint(`CLIFFORD - A Maple 6 Package for Clifford Alge bras`); \nprint(`(Version 6 with global variable _prolevel and \"Bigeb ra\" package)`);\nprint(`\"Bigebra\" package written with Bertfried Fa user, Universit\"at Konstanz`);\nprint(`Last revised: November 1, 2002 (Source file: clifford6_12.mws)`);\nprint(`Copyright 1995-2003 by Raf al Ablamowicz (*) and Bertfried Fauser ($)`);\nprint(``);\nprint(`(*) \+ Department of Mathematics, Box 5054`);\nprint(` Tennessee Technolog ical University, Cookeville, TN 38505`);\nprint(` tel: USA (931) 37 2-3569, fax: USA (931) 372-6353`);\nprint(` rablamowicz@tntech.edu` );\nprint(` http://math.tntech.edu/rafal/Clifford/`);\nprint(`($) U niversit\"at Konstanz, Fachbereich Physik, Fach M678`);\nprint(` 78 457 Konstanz, Germany`);\nprint(` Bertfried.Fauser@uni-konstanz.de` );\nprint(` http://kaluza.physik.uni-konstanz.de/~fauser/`); \+ \nprint(``);\nprint(`If you are a Clifford algebra pro, assign 'true' \+ to '_prolevel' and see`);\nprint(`how much faster your computations wi ll be! But watch your syntax!`);\nprint(`Use 'useproduct' to change va lue of _default_Clifford_product in Cl(B) from`);\nprint(`cmulRS when \+ B is symbolic to cmulNUM when B is numeric. Type ?cmul for help.`); \n print(`++++++++This is CLIFFORD version 6, library file : Clifford.m++ ++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Proced ure " }{TEXT 282 17 "specify_constants" }{TEXT -1 503 " allows user to specify any new symbolic constants, e.g., a, b, c, B, e.t.c, which a re to be known to Maple. The originally known constants are stored in a global, non-protected variable 'constants' and must be saved separa tely, if needed. This procedure is needed when sorting or collecting \+ multivariate Clifford polynomials containing expressions like 'aa*eiwe j' in which 'aa' is intended to be a constant and 'eiwej' is intended \+ to be a Clifford basis monomial with indices i and j. Before using " }{TEXT 281 7 "clisort" }{TEXT -1 4 " or " }{TEXT 280 10 "clicollect" } {TEXT -1 350 " user should make any additional constants of length 2 o r more known to Maple as shown below. If these constants of length 2 \+ or more are not defined as Maple constants, then some procedures might yield error messages (although an attempt has been made to avoid this problem). Constants of length one are automatically assumed to be Map le constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: specify_constants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have been added for the Reader's convenience in \+ the sequence of input variables as in the above example. These spaces \+ are not needed or required by Maple." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 371 "specify_constants:=proc(a1::anyt hing) global constants;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 1, 2002`;\n####################################### ######\nconstants:=op(\{constants,args\});\nprintf(\"Maple now knows t he following constant(s): %q\\n\",constants);\nreturn NULL;\nend proc: \n" }}{PARA 258 "" 0 "" {TEXT -1 21 "No. 3. The procedure " }{TEXT 283 6 "cbasis" }{TEXT -1 793 " writes a canonical basis for a Clifford algebra Cl(B) over a vector space V endowed with a bilinear form B. \+ The dimension of V is specified by a Maple global variable 'dim' where 1 <= dim <= 9. This procedure can be used with one or two arguments \+ as, for example, in cbasis(4) or cbasis(4, 2). In the first case, it \+ returns a list of all basis elements in the Clifford algebra Cl(4). In the second case, it returns a list of basis elements in the 2-vector \+ subspace of Cl(4). Below, 'Id' stands for the algebra unit element and 'w' denotes wedge/exterior product in the Clifford algebra. An option 'even' allows one to create a basis in the even subalgebra of the giv en Clifford algebra as in cbasis(3, 'even'). In fact, 'even' can be r eplaced with any name which evaluates to a string. \n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1875 "cbasis:=proc(a1::nonnegint,a2::\{string,symb ol,nonnegint\})\nlocal i,k,X,XX,YY,L,Leven,Lodd,bas,nxt,ind,start; glo bal choose,e;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`,remember;\ndescription `Last revised: November 1, 2002`;\n######################################## #####\nif a1>9 then \n error \"first argument must be between 0 and \+ 9 inclusive but received %1 instead\",a1 \nend if;\nif a1=0 and nargs= 1 then return [Id] end if;\nif nargs=2 and type(a2,\{string,symbol\}) \+ then do\n L:=procname(a1):\n Leven:=[Id]:Lodd:=[]:\n if nops(L) \+ > 1 then\n for i from 2 to nops(L) do\n if type(length(L[i]),o dd) then Leven:=[op(Leven),L[i]] else\n \+ Lodd:=[op(Lodd),L[i]]\n end if \n end do \n end if; \+ \nif args[2]='even' then return Leven \n elif args[2]='odd' then ret urn Lodd\n else error \"second argument must be an integer or a stri ng 'even' or 'odd' but received %1 instead\",args[2]\nend if\nend do \+ \nend if;\nfor k from 0 to a1 do \n X[k]:=combinat[choose]([seq(i,i =1..a1)],k) \nend do;\nif not nargs = 1 and not nargs = 2 then \n er ror \"one or two arguments are needed as input but received %0 instead \",args\nelif nargs = 1 then XX:=[seq(op(X[k]),k=0..a1)] \nelse if not a2 >= 0 or not a2 <= a1 then \n error \"second argument must satisfy: 0 <= 'a2' <= %1 but received %2 instead\",a1,a2 \nelse XX:=X[a2] \nen d if \nend if;\nYY:=array(1..nops(XX),[]);start:=1:\nif XX[1] = [] th en \n YY[1]:=Id; \n start:=2 \nend if;\nfor k from start to nops(X X) do\n ind:=XX[k][1];\n if ind=10 then \n bas:=e||0 else \+ bas:=e||ind \n end if;\nfor i from 2 to nops(XX[k]) do \n ind:=X X[k][i]:\n if ind=10 then nxt:=e||0 else nxt:=e||ind end if:\n \+ bas:=cat(bas,\"w\",nxt): \n end do;\nYY[k]:=bas;\nend do:\nYY:=co nvert(YY,list);\nprotect(op(YY)); #protect basis monomials\nreturn YY \nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " } {TEXT 284 8 "find1str" }{TEXT -1 327 " finds all locations of the firs t string of length one in the second string of length at least one. It returns a set of these positions. If the first string is not found t hen it returns \{0\}. This procedure is primarily for internal use in \+ 'type/clibasmon' and 'cliparse'. \nTypical use: find1str(e,e1we2we3); \+ find1str(w,e1we2);" }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 662 "find1str:=proc(a1::symbol,a2::symbol) local ns,p,p1, ap,le2;\nglobal _prolevel;\noptions `Copyright (c) 1995-2003 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndesc ription `Last revised: November 1, 2002`;\n########################### ##################\nle2:=length(a2):\nif _prolevel=false then\nif leng th(a1) <> 1 or le2<1 then \n error \"first string must be of length \+ 1 but received %1 instead\",a1 \nend if;\nend if;\np:=SearchText(a1,a 2):\nap:=\{p\}:p1:=p:\nwhile p<>0 and p10 then p1:=p1+p;\n \+ ap:=ap union \{p1\} \n end if;\nend do;\nreturn ap\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 5. Function " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " checks user's input for correct spell ing of basis monomials. When unable to decide if the given input is c orrect, it tells the user to check spelling or define the given string as a Maple constant. If the spelling is correct, it returns true; if \+ it is not correct, it returns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1179 "cliparse:=proc(a1::anything) local x,S1,S2,p,S;\nglobal _proleve l,_scalartypes;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: November 1, 2002`;\n#############################################\n if _prolevel then return true end if;\nif type(a1,_scalartypes) then r eturn true end if;\np:=remove(type,a1,_scalartypes):S1:=\{op(p)\}:\nfo r x in S1 do \n if type(x,_scalartypes) or type(x,clibasmon) then S 1:=S1 minus \{x\} end if;\nend do; \nS2:=map(op,S1); \nfor x in S2 do \+ \n if type(x,_scalartypes) or type(x,clibasmon) then S2:=S2 minus \+ \{x\} end if;\nend do;\nS:=remove(hastype,map(op,\{op(expand(p))\}),\{ op(_scalartypes),clibasmon\});\nfor x in S do \n if find1str(e,x)= \{0\} and x<>'Id' then S:=S minus \{x\} end if;\nend do;\nif S=\{\} th en return true end if;\nS1:=select(type,S,procedure):\nif S1 <> \{\} t hen\n error \"procedure name %1 that has been found in input is not \+ allowed as a symbolic coefficient\",op(S1)\nend if;\nif nops(S)=1 then \n error \"check spelling of %1 or define it as a constant or an al ias\",op(S)\nelse \n error \"check spelling of %1 or define them as \+ constants or aliases\",op(S) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Function " }{TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered Clifford scalar with the scalar times th e unit element 'Id'. It may also be applied to matrices with Clifford \+ algebra entries.\n\nTypical use: displayid(e1+2*Pi);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 621 "displayid:=proc(a1::\{array,matrix,algebraic \}) local KK,p;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: November 1, 2002`;\n#############################################\n KK:=proc() if type(args[1],cliscalar) then return args[1]*Id \n \+ elif hastype(args[1],clibasmon) then return args[1] \n e nd if \nend proc:\nif type(a1,\{array,matrix\}) then return map(procna me,a1) end if;\np:=expand(a1):\nif type(p,\{`*`,cliscalar,clibasmon,cl imon\}) then return KK(p) \nelif type(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " }{TEXT 287 8 "cliterms" }{TEXT -1 222 " iden tifies Clifford basis elements in the given Clifford polynomial.\n\nNO TE: 'cliterms' also works with terms of type cliprod and it finds corr ectly terms involving such expressions. \n\nTypical use: cliterms(2*Pi +2*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1019 "cliterms:= proc(a 1::anything) local S1,S2,S3,x,p,Cliplusflag;\noptions `Copyright (c) 1 995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: November 1, 2002`;\n################## ###########################\nCliplusflag:=assigned(Cliplus):\nif hasty pe(a1,cliprod) and not Cliplusflag and _warnings_flag then \n WARNIN G(`argument to 'cliterms' contains type cliprod. Load 'Cliplus' to ext end functionality of CLIFFORD. Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,cliprod\}) then return \{a1\} end if;\np:=display id(simplify(a1)):\nif hastype(p,cliprod) then \n S1:=remove(type,\{o p(p)\},cliscalar);\n S2:=select(hastype,S1,\{clibasmon,climon,clipro d\});\n S3:=\{\}:\n while not S2=\{\} do\n S3:=S3 union se lect(type,S2,\{clibasmon,cliprod\});\n S2:=select(hastype,map( op,remove(type,S2,\{clibasmon,cliprod\})),\{clibasmon,cliprod\});\n \+ end do;\nreturn S3\nend if;\nx:='x':\nS1:=remove(type,\{op(p)\},clisca lar);\nreturn \{seq(select(hastype,x,clibasmon),x=S1)\}\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " }{TEXT 288 11 "cli bilinear" }{TEXT -1 360 " makes any procedure K specified as the third argument bilinear with respect to Clifford scalars in the first two a rguments. The first two arguments are of the type clipolynom, i.e., Cl ifford polynomials. The third argument is a string or a procedure.\nIt can handle terms involving elements of type cliprod.\n\nTypical use: \+ clibilinear(e1+2*e2we3,Id+2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 922 "clibilinear:=proc(a1,a2,a3::\{procedure,name,symbol,matrix,ar ray\}) \n local tail,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1 ,co2;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Novembe r 1, 2002`;\n#############################################\nif simplif y(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1): \np2:=clicollect(a2):\n tail:=args[4..-1];\n if type(p1,\{climon,cli prod\}) then S1:=[p1] else S1:=[op(p1)] end if:\n if type(p2,\{climon ,cliprod\}) then S2:=[p2] else S2:=[op(p2)] end if:\n S12:=[seq(seq([ x,y],x=S1),y=S2)];#this list will be huge for long polynomials\n res: =0:\n for x in S12 do \n cli1:=select(type,x[1],\{cliprod,clibasmo n\}):\n cli2:=select(type,x[2],\{cliprod,clibasmon\}):\n co1:=co eff(x[1],cli1):\n co2:=coeff(x[2],cli2):\n res:=res+co1*co2*a3(c li1,cli2,tail):\n end do:\n return res;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 17 "No. 9. Procedure " }{TEXT 289 9 "clilinear" } {TEXT -1 336 " makes any procedure K specified as the second argument \+ linear with respect to Clifford scalars (elements of type cliscalar). \+ It can now distribute over Clifford polynomials with elements of `type /cliprod`. Any additional parameters are passed on to the procedure en tered as the second argument.\nTypical use: clilinear(a*e1+2*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 621 "clilinear:=proc(a1::\{symbol ,cliscalar,clibasmon,climon,clipolynom\},a2::\{name,procedure\}) \nloc al tail,p1,S1,res,x,cli1,co1;\noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: November 1, 2002`;\n################################# ############\ntail:=args[3..-1];\nif type(a1,cliscalar) then return a1 *a2(Id,tail) end if;\np1:=displayid(a1):\nif type(p1,climon) then S1:= [p1] else S1:=[op(p1)] end if:\nres:=0:\nfor x in S1 do\n cli1:=sel ect(hastype,x,\{clibasmon,cliprod\}):\n co1:=coeff(x,cli1); \nres:= res+co1*a2(cli1,tail):\nend do:\nreturn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 10. Procedure " }{TEXT 290 7 "clisort" } {TEXT -1 312 " sorts the given multivariate Clifford polynomial with r espect to the Clifford indetereminates found in the expression via the procedure 'cliterms'. It puts scalar coefficients of the type cliscal ar in front of the Clifford basis monomials. It may also be applied to matrices with entries in a Clifford algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 40 "Typical use: clisort(2* e1we2 - e1*b); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 427 "clisort:=pro c(p::algebraic) local L,N;\noptions `Copyright (c) 1995-2003 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: November 1, 2002`;\n#################################### #########\nif type(p,matrix) then return map(procname,p) end if;\nif t ype(p,\{climon,clipolynom\}) or hastype(p,cliprod) then\n L:=cliterm s(expand(displayid(p)));\n return sort(p,L);\nend if:\nreturn p\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " } {TEXT 291 10 "clicollect" }{TEXT -1 382 " reorders monomial terms in s tandard order and then collects them in a multivariate Clifford polyno mial. It may also be applied to matrices with entries in a Clifford al gebra. It will simplify 6 + 7*Id to 13*Id. It collects now terms of t ype cliprod, if present.\n\nNOTE: 'clicollect' also works with terms o f type cliprod and it collects correctly terms involving such expressi ons. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: clicollect(e1 + a*e1 - e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 496 "clicollect:=proc(a1::algebraic) local p,L; \nopti ons `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`; \n#############################################\nif type(a1,matrix) th en return map(procname,a1) end if;\np:=expand(a1):\nif type(p,cliscala r) then return p*Id\nelif type(p,clipolynom) then \n L:=cliterms(p );\n return map(simplify,collect(displayid(p),L,'distributed'))\ne lse return args[1] \nend if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. The procedure " }{TEXT 292 3 "ord" }{TEXT -1 319 " ret urns an ordered list of positions in a monomial, e.g., e1we2, where v ector indices are found. Then, nops(ord(e1we2)) can be used to find \+ the order of the monomial. Note that for consistency we have ord(Id) \+ = ord(numeric) = ord(numeric*Id) = ord(cliscalar)=[] where cliscalar i s any object of the type cliscalar." }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 35 "This procedure is for internal use. " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 386 "ord:=proc(a1) local v,k;\noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: November 1, 2002`;\n################################# ############\nif type(a1,cliscalar) then return [] end if;\nv:=select( type,a1,clibasmon);\nif v = Id then return [] end if;\nk:='k':\nreturn [seq(2+3*k,k=0..((length(v)+1)/3-1))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 13. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes one symbol 'ei' from the location specified by the pr ocedure 'ord'. \n(NOTE: procedure 'ord' specifies location of the inde x 'i' in 'ei'.) This procedure is primarily for internal use." }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 578 "cl iremove:=proc(p::posint,s::symbol) local S1,S2;global _prolevel;\nopti ons `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndescription `Last revised: November \+ 1, 2002`;\n#############################################\nif not _prol evel then\n if s=Id then error \"second argument must be Grassmann b asis monomial of rank >= 1\" end if;\nend if;\nS2:=substring(s,(p+2).. length(s));\nS1:=substring(s,1..(p-3));\nif length(S2)=0 and S1 <> s t hen return S1 \n elif S1 = s then return S2 \n else return cat(S1, \"w\",S2); \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 14. Procedure " }{TEXT 294 7 "extract" }{TEXT -1 445 " extracts ind ices of a monomial (or a constant times a monomial) and it returns the m as a list of strings. If necessary, they can be returned as a list \+ of integers if option 'integers' is selected (in fact, any name which \+ evaluates to a string may be used as the option). Indices could be no w integers, letters, or they could be mixed. Note that extract(Id) = [ ] and extract(numeric) = extract(numeric*Id) = [] results in no vecto r indices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typical use: extract(2*e1we2); or extract(e2we3, \"intege rs\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 780 "extract:=proc(a1::\{symbol,cliscalar,clibasmon,climo n\},a2::symbol) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`,remember;\ndescription `Last revised: November 1, \+ 2002`;\n#############################################\nif type(a1,clis calar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n \+ type(a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nels e \n error \"wrong argument: %1\",a1 \nend if;\nif v = Id then retur n [] end if;\nk:='k':\ninds:=[seq(substring(v,(2+3*k)..(2+3*k)),k=0..( (length(v)+1)/3-1))];\nif nargs=1 then return inds \n elif type(a2,s ymbol) then return map(convert,inds,str_to_int)\n else error \"wrong option or number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 19 "No. 15. Procedure " }{TEXT 295 7 "reorder" } {TEXT -1 330 " reorders Clifford monomials in the given Clifford polyn omial using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e 1we2 - 2*e1we2we5. If any one of the indices of the monomial is a lett er, e.g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reor der now can order monomials and polynomials with symbolic coefficients , e.g. reorder(ejwei) = -eiwej, using the lexicographic order. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typic al use: reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1075 "reorder:=proc(a1::algeb raic) \n local L1,L2,N,newbas,f,a,x,K,dummy_set,n12,s12,ss;\n \+ global B,dim_V;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 1, 2002`;\n####################################### ######\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) en d if; \nL1:=Clifford:-extract(a1);\nN:=nops(L1);\nif N>9 then error \" detected basis monomial of grade higher than 9 in the input\" end if; \nif N=0 or N=1 then return a1 end if;\nn12,s12:=selectremove(member,L 1,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n#s12:=remove(member,L1,\{ `1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\nL2:=[op(sort(n12)),op(sort(s1 2))];\nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss] ;\nend do:\ndummy_set:=convert(L1,set):\nK:=0:\nwhile dummy_set <> \{ \} do\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n \+ while f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set minus \{x \};\n K:=K+1;\n end do:\nend do:\nnewbas:=cat(e||(op(L2[1..-2])) ||w,e,L2[-1]):\nreturn (-1)^K*newbas\nend proc:\n" }}{PARA 258 "" 0 " " {TEXT -1 35 "No. 16. Defining a useful function " }{TEXT 296 8 "maxi ndex" }{TEXT -1 226 " which finds the greatest index in the given Clif ford polynomial or in the given list or set of Clifford monomials. It \+ returns 0 for a Clifford scalar (an element of type cliscalar).\n\nTyp ical use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 812 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: November 1, 2002`;\n################ #############################\nif type(a1,cliscalar) or a1=Id then ret urn 0 elif\n type(a1,list) then return max(op(convert(map(procname,a 1),set))) elif\n type(a1,set) then return max(op(map(procname,a1))) \+ else \n mons:=cliterms(a1);\n inds:=map(op,map(Clifford:-extract,m ons,'integers'));\n symbinds:=remove(type,inds,integer);\n if symb inds = \{\} then\n if inds=\{\} then return 0 else return max(op( inds)) end if;\n else\n error \"cannot determine maximum index \+ because input contains symbolic index or indices\"\n end if;\n end \+ if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining a \+ useful function " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which finds \+ the maximum grade in the given Clifford polynomial. It returns 0 for \+ a Clifford scalar (an element of type cliscalar).\n\nTypical use: maxg rade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 387 "maxg rade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\nop tions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: November 1, 2002 `;\n#############################################\nif type(a1,cliscala r) then return 0 end if;\nS:=\{op(cliterms(a1))\}:\nreturn max(op(map( nops,map(Clifford:-extract,S))))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 18. Procedure " }{TEXT 298 2 "LC" }{TEXT -1 233 " de fines a left contraction between any multivector u and a multivector v , i.e., multivector u acts on the multivector v from the left. This p rocedure is now bilinear in both arguments. It can accept third argum ent such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 46 "Typical use: LC(e1 + 2*e2, e1we3 + b*e2we3); \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 2276 "LC:=proc(x::\{cliscalar,clibasmo n,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climon,clipo lynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2003 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: November 1, 2002`;\n######################################### ####\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \+ \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3]; \n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) th en\n coB:=op(select(type,\{op(args[3])\},numeric));\n name B:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third argument in LC. See ?LC \+ for more help.\" \n end if;\nelse\n error \"two or three argument s expected in LC. See ?LC for more help.\"\n end if;\n################ ################\n if type(x,clibasmon) then\n if type(y,clibasmon ) then\n lst1:=Clifford:-extract(x,'integers');\n lst2:=Clif ford:-extract(y,'integers');\n N1:=nops(lst1);N2:=nops(lst2);\n \+ if N1>N2 then return 0 end if;\n if N1=0 then return y end if ;\n if N1=1 then \n res:=`+`(seq(coB*nameB[lst1[1],lst2[j ]]*_CLIENV[_QDEF_PREFACTOR]^(j-1)*\n makeclib asmon([op(subs(lst2[j]=NULL,lst2))]),j=1..N2));\n return reord er(res) \n else\n res:=\nprocname(makeclibasmon(lst1[1..-2]) ,procname(makeclibasmon([lst1[-1]]),y,lname),lname);\n return \+ reorder(res)\n end if;\n elif type(y,climon) then\n ter m,cf:=selectremove(type,y,clibasmon);\n return expand(cf*procn ame(x,term,lname))\n elif type(y,clipolynom) then\n retur n add(procname(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) the n \n return displayid(scalarpart(x)*y)\n end if; \n elif type(x,climon) then\n term,cf:=selectremove(type,x,clibasmon);\n \+ return expand(cf*procname(term,y,lname))\n elif type(x,clipolynom) \+ then\n return add(procname(i,y,lname),i=[op(x)])\n elif type(x,cli scalar) then \n return x*reorder(y)\n end if;\nerror \"Got input \+ %1 and %2 but LC can only process constants and Clifford numbers\",x,y ;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 19. Procedure " } {TEXT 299 3 "LCQ" }{TEXT -1 270 " is a special version of 'LC' and giv es left contraction in the orthogonal Clifford algebra Cl(Q) of the qu adratic form Q defined via the symmetric part g of B as Q(x) = g(x, x) = B(x, x). It can accept name as a third optional argument or a nume ric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fou rier, Grenoble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e 2we3);\nLCQ(e1 + 2*e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1794 "LCQ:=proc(x::\{cliscalar,clibasmon,climon,clipolyno m\},\n y::\{cliscalar,clibasmon,climon,clipolynom\}) \n l ocal ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: November 1, 2002`;\n############ #################################\nif nargs=2 then\n coB:=1:\n n ameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3], \{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args [3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{nam e,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3 ])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric) );\n lname:=args[3]:\n else \n error \"wrong type of th ird argument in LCQ. See ?LCQ for more help.\" \n end if;\nelse\n \+ error \"two or three arguments expected in LCQ. See ?LCQ for more hel p.\"\nend if;\n################################\nSxy:=remove(type,map( op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy ,'integers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} th en \n return LC(x,y,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is neede d when both x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldim](evalm(lname)):\n if m>N then \n error \+ \"input contains index larger than size of bilinear form %1\",lname \n end if;\nend if:\nif type(lname,\{name,symbol,array,matrix\}) then \n L:=seq(lname[ii,ii],ii=1..m);\n return LC(x,y,linalg[diag](L)) \nelif \n type(lname,`&*`(numeric,\{name,symbol,array,matrix\})) the n\n coB:=op(select(type,\{op(lname)\},numeric));\n nameB:=op(selec t(type,\{op(lname)\},\{name,symbol,array,matrix\}));\n L:=seq(coB*na meB[ii,ii],ii=1..m);\n return LC(x,y,linalg[diag](L))\n end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 20. Procedure " } {TEXT 300 2 "RC" }{TEXT -1 241 " defines a right contraction between a ny multivector u and a multivector v, i.e., multivector u acts on the \+ multivector v from the right. This procedure is now bilinear in both \+ arguments. It can accept third optional argument like B or -B." }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 258 46 "Typical \+ use: RC(e1 + 2*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2279 "RC:=proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ y::\{cliscalar,clibasmon,climon,clipolynom\})\n local N1,N2,lst1 ,lst2,i,j,cf,term,lname,res,coB,nameB;\n global _CLIENV,B;\noptions ` Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n### ##########################################\nif nargs=2 then\n coB:= 1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type (args[3],\{name,symbol,matrix,array\}) then\n coB:=1:\n na meB:=args[3];\n lname:=args[3];\n elif type(args[3],`&*`(nume ric,\{name,symbol,matrix,array\})) then\n coB:=op(select(type,\{ op(args[3])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\} ,numeric));\n lname:=args[3]:\n else \n error \"wrong t ype of third argument in RC. See ?RC for more help.\" \n end if;\ne lse\n error \"two or three arguments expected in RC. See ?RC for mor e help.\"\nend if;\n################################\n if type(x,clib asmon) then\n if type(y,clibasmon) then\n lst1:=Clifford:-extr act(x,'integers');\n lst2:=Clifford:-extract(y,'integers');\n \+ N1:=nops(lst1);N2:=nops(lst2);\n if N2>N1 then return 0 end if; \n if N2=0 then return x end if;\n if N2=1 then \n r es:=`+`(seq(coB*nameB[lst1[-i],lst2[1]]*_CLIENV[_QDEF_PREFACTOR]^(i-1) *\n makeclibasmon([op(subs(lst1[-i]=NULL,lst1))]),i =1..N1));\n return reorder(res) \n else\n res: =procname(procname(x,makeclibasmon([lst2[1]]),lname),\n \+ makeclibasmon(lst2[2..-1]),lname);\n return reorder(res)\n end if;\n elif type(y,climon) then\n term ,cf:=selectremove(type,y,clibasmon);\n return expand(cf*procname( x,term,lname))\n elif type(y,clipolynom) then\n return add(pro cname(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) then return re order(x)*y \n end if;\n elif type(x,climon) then\n term,cf:=se lectremove(type,x,clibasmon);\n return expand(cf*procname(term,y,ln ame))\n elif type(x,clipolynom) then\n return add(procname(i,y,lna me),i=[op(x)])\n elif type(x,cliscalar) then \n return displayid(x *scalarpart(y))\n end if;\nerror \"Got input %1 and %2 but can only \+ process constants and Clifford numbers\",x,y\nend proc:\n" }}{PARA 0 " " 0 "" {TEXT 259 18 "No. 21. Procedure " }{TEXT 301 3 "RCQ" }{TEXT 302 85 ": Right contraction in Cl(Q). It can accept third optional arg ument such as K or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1799 "RCQ:=proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ y::\{cliscalar,clibasmon,climon,clipolynom\}) \n local ii,N ,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995 -2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: November 1, 2002`;\n##################### ######################## \nif nargs=2 then\n coB:=1:\n nameB:=` B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name, symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n \+ lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symbo l,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},nu meric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third arg ument in RCQ. See ?RCQ for more help.\" \n end if;\nelse\n error \+ \"two or three arguments expected in RCQ. See ?RCQ for more help.\"\ne nd if;\n################################\nSxy:=remove(type,map(op,\{op (x),op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integ ers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n \+ return RC(x,y,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when \+ both x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N :=linalg[coldim](evalm(lname)):\n if m>N then \n error \"in put contains index larger than size of bilinear form %1\",lname \n e nd if:\nend if:\nif type(lname,\{name,symbol,array,matrix\}) then\n \+ L:=seq(lname[ii,ii],ii=1..m);\n return RC(x,y,linalg[diag](L))\nelif \n type(lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n \+ coB:=op(select(type,\{op(lname)\},numeric));\n nameB:=op(select(type ,\{op(lname)\},\{name,symbol,array,matrix\}));\n L:=seq(coB*nameB[ii ,ii],ii=1..m);\n return RC(x,y,linalg[diag](L))\n end if;\nend proc: " }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " }{TEXT 303 8 "gradeinv" }{TEXT -1 133 " is the grade involution in the Clifford alg ebra,i.e., it reverses signs of odd elements and leaves signs of even \+ elements unchanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typical use: gradeinv(e1 + e1we2 - 4*e3we4); \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 552 "gradeinv:=proc(a1::\{matrix,clisc alar,clibasmon,climon,clipolynom\}) global _CLIENV;\noptions `Copyrigh t (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: November 1, 2002`;\n########### ##################################\nif type(a1,matrix) then return map (procname,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PR EFACTOR]:=-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDE F_PREFACTOR])^maxgrade(a1)*a1 \n else return clil inear(a1,procname) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 23. Define the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " prod uct of any number of Clifford polynomials. The infix form of this ass ociative multiplication is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, wedge multiplication may \+ be applied to matrices with entries in a Clifford algebra or in an ext erior algebra.\n\nNew feature: When the dimension of the vector space \+ is known, either from the size of the matrix B or from the global para meter dim_V that can be set by the user, the output of the procedure d oes not include terms of grade higher than the dimension of the vector space in case symbolic indices are used. \n\nThe default value of thi s global variable is 9 and it it set by the initialization file when C lifford is loaded.\n\nWhen the procedure is invoked, it checks whether the bilinear form B has been defined. If yes, the procedure checks wh ether the size of B is less than the current value of dim_V. If again \+ yes, a warning message is issued by the procedure and the value of dim _V is reduced. If the size of B is larger than the current value of di m_V, no warning message is issued and the value of dim_V is increased to linalg[coldim](B).\n\nThe warning message can be supressed by addi gn 'false' to a global parameter _warnings_flag whose default value is set to true by the Clifford initialization file." }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e4 + e1we2); wedge(e2 + 2*e1, e3, e4); (e2 + 2*e1) &w (e3 + 2* ); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3061 "wedge:=proc(a1::\{clisc alar,clibasmon,climon,clipolynom\},\n a2::\{cliscalar,cliba smon,climon,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12, maxindexflag,expr,maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Cop yright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: November 1, 2002`;\n###### #######################################\nkk:='kk':\nif member(0,[args] ) then return 0 \nelif \n remove(type,\{args\},cliscalar)=\{\} then \+ return product(args[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then \n if linalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < d im_V then\n dim_V:=linalg[coldim](B);\n if _warnings_f lag then\nprintf(\"Warning, since B has been (re-)assigned, value of d im_V has been reduced by 'wedge' to %g\\n\",dim_V);\n end if; \n elif linalg[coldim](B)>dim_V then\n dim_V:=linalg[coldim](B) ;\n end if;\n end if;\n end if; \nif not type(dim_V,Range(0,10 )) or \n not type(dim_V,posint) then\n error \"value of dim_V must be a positive integer between 1 and 9, inclusive, but current value o f dim_V is %1\",dim_V\nend if;\n################\ni12:=\{\}:\nfor ii f rom 1 to nargs do\n pi:=args[ii]: \n i12:=i12 union map(op,map(C lifford:-extract,cliterms(pi),'integers')):\nend do;\nn12:= select(mem ber,i12,\{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{\} then\n maxin:=max(o p(n12)); \n maxindexflag:=evalb(maxin > dim_V);\nelse maxindexflag:= false:\nend if:\nif maxindexflag then \n error \"argument(s) contain (s) index larger then current value of dim_V which is now %1. To compl ete computation, increase value of dim_V or assign square matrix of si ze at least %2 by %3 to bilinear form B\",dim_V,maxin,maxin\nend if;\n ################\nwedge2:=proc() local expr,i1,i2,n1,n2,i12,s12,symbin dexflag;global dim_V;\n i1:=\{op(Clifford:-extract(args[1]))\};n1:=nop s(i1):\n i2:=\{op(Clifford:-extract(args[2]))\};n2:=nops(i2):\n if arg s[1]=Id then \n if n2>dim_V then return 0 else return args[2] end i f;\n end if;\n if args[2]=Id then \n if n1>dim_V then return 0 else return args[1] end if;\n end if;\n i1:=\{op(Clifford:-extract(args[ 1]))\};\n i2:=\{op(Clifford:-extract(args[2]))\};\n i12:=i1 union \+ i2;\n s12:= remove(member,i12,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9` \}):\n symbindexflag:=evalb(not s12=\{\}):\n if i1 intersect i2 <> \{\} then return 0 end if;\n if symbindexflag and nops(i1)+nops(i2) > dim_V then return 0 end if;\nreturn reorder(cat(args[1],\"w\",args[ 2]));\nend proc:\n################\nif nargs=1 then return args\nelif \+ nargs=2 then p1:=displayid(a1):\n p2:=displayid(a2): \n expr:=clibilinear(p1,p2,wedge2);\n \+ if hastype(expr,trig) then \n return clicollect( map(combine,clicollect(expr),trig))\n else \n \+ return reorder(expr)\n end if;\nelse exp r:=procname(procname(a1,a2),args[3..nargs]):\n if hastype(expr,tri g) then \n return clicollect(map(combine,clicollect(expr),trig) )\n else \n return reorder(expr)\n end if;\nend if;\nen d proc:\n" }}{PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampersand version o f " }{TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford: -setup)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " computes sign of a permutation that \+ sorts a list of indices.\n\nTypical use: permsign([1,3,2]); permsign([ j,1,i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 880 "permsign:=proc(L ::list) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `C opyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: November 1, 2002`;\n#### #########################################\nL1:=L:\nN:=nops(L1):\nif N= 1 then return 1 end if:\n################## new\nn12,s12:=selectremove (member,L1,\{1,2,3,4,5,6,7,8,9\});\n#s12:=remove(member,L1,\{1,2,3,4,5 ,6,7,8,9\});\nL2:=[op(sort(n12)),op(sort(s12))];\n################## n ew\nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss];\n end do;\ndummy_set:=convert(L1,set);\nK:=0:\nwhile dummy_set <> \{\} d o\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n whil e f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set minus \{x\}; \n K:=K+1;\n end do:\nend do;\n#newbas:=cat(e.(op(L2[1..-2])).w, e,L2[-1]):\n#return ((-1)^K*newbas);\nreturn (-1)^K;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 26. Procedure " }{TEXT 309 7 "cmulN UM" }{TEXT -1 148 " calculates Clifford product between any two Cliffo rd monomials using the recursivelyChevalley's definition of the Cliffo rd product: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 93 " \+ xu = wedge(x, u) + LC(x, u) = x &w u + LC(x, u) " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 477 "where x is a ve ctor and u is any element in the algebra, wedge(x,u) = x &w u denotes \+ the wedge or exterior product between x and u, and LC(x, u) denotes t he left contraction of u by x. This procedure is now bilinear in both \+ arguments. The infix form is available e.g., e1 &c e2. This procedur e works in Clifford algebras in dimensions up to and including 9. Mul tiplication of matrices with entries in a Clifford algebra can be done with a procedure 'rmulm' described below." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure requires thir d argument of type name or a numeric multiple of a name. Then it compu tes Clifford product in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nTh is version can take index as a way of passing a parameter. The index \+ could be of type `&*`(numeric,\{name,symbol,array,matrix\}) or of type \{name,symbol,array,matrix\}.\n\nWhen the bilinear form B is symboli c, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 264 55 "Typical use: cmulNUM(e1,e3we4,B); cmulNUM(e1,e3we4,-K); " }{TEXT 265 3 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2253 "cmulNUM:= proc(a1,a2,lname) \n local L,N,L2,x,x1,x2,S,i,ii,T1,T2,K,p1,p2,coB,na meB,a12;global B:\n options `Copyright (c) 1995-2003 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n description `Last \+ revised: November 1, 2002`;\n######################################### ####\n###This is additional code for Maple 6 version:\n############### ##############################\nif hastype(\{a1,a2\},cliprod) then\n \+ a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-cliexpand(cli bilinear(a12[1],a12[2],procname,lname))\nend if: \n################### ###################################################################\n# ## old name cmul2B: this procedure computes recursively Clifford produ ct of any two #\n### cliscalars, clibasmons, climons, and clipolynoms \+ in Clifford algebras Cl(lname) #\n################################### ###################################################\n if nargs<>3 the n error \"exactly three arguments are needed\" end if:\n if has(0,map (simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` then return a1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-extract( a1,'integers');\n N:=nops(L):\n ################\n ##### The follow ing will allow for lname to be -B, for example:\n if type(lname,\{nam e,symbol,array,matrix\}) then\n coB,nameB:=1,lname:\n elif type(l name,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(se lect(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},name));\n else\n error \"third argument is of unexpected t ype\"\n end if;\n ################\n if N=0 then return coeff(a1,Id )*a2\n elif N=1 then\n L2:=Clifford:-extract(a2,'integers'):\n \+ return reorder(simplify(makeclibasmon([L[1],op(L2)])\n +add((-1)^( i-1)*coB*nameB[L[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..nop s(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:=substring(a1 ,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1,p2,proc name,lname);\n return simplify(S-coB*nameB[op(L)]*a2)\n end if;\n \+ x:=cat(e,L[-1]);\n p1:=substring(a1,1..(3*N-4));\n p2:=procname(x,a 2,lname):\n S:=clibilinear(p1,p2,procname,lname)\n -add((-1)^(i) *coB*nameB[L[-i],L[-1]]*\nprocname(makeclibasmon(subs(L[-i]=NULL,L[1.. -2])),a2,lname),i=2..N); \n return reorder(simplify(S))\nend proc:\n " }}{PARA 0 "" 0 "" {TEXT 266 19 "No. 27. Procedure " }{TEXT 310 6 "c mulRS" }{TEXT 311 114 " computes Clifford product using Rota-Stein cli ffordization technique. It can accept now -K in place of the name.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4902 "cmulRS:=proc(a1,a2,lname)\nloca l max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n pLi st2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a12;\nopti ons `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`; \n#############################################\n###This is additional code for Maple 6 version:\n########################################## ###\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clieval, [a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12[2],proc name,lname))\nend if: \n############################################## ############################################\n### This procedure compu tes Clifford product of any two cliscalars, clibasmons, climons, #\n## # and clipolynoms in Clifford algebras Cl(lname) using Rota-Sten cliff ordization #\n### Procedure cmulRS modified by Rafal to accept - K, or -B for lname. #\n############################ ##############################################################\n if n args<>3 then error \"exactly three arguments are needed\" end if:\n i f has(0,map(simplify,[a1,a2])) then return 0 end if;\n if a1 = `Id` t hen return a2 end if;\n if a2 = `Id` then return a1 end if;\n ###### ##########\n ##### The following will allow for lname to be -B, for e xample:\n if type(lname,\{name,symbol,array,matrix\}) then\n coB, nameB:=1,lname:\n elif type(lname,`&*`(numeric,\{name,symbol,array,ma trix\})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n error \"thi rd argument is of unexpected type\"\n end if;\n ################\n \+ L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Clifford :-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \n retur n reorder(simplify(makeclibasmon([L1[1],op(L2)])\n +add((-1)^(i-1)* coB*nameB[L1[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..N2)))\n end if;\n if N2=1 then \n return reorder(simplify(makeclibasmon( [op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*makecliba smon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; generat e a power set of 1..N, option remember\n genPS:=proc(N)\n local a, i,plst;\n option remember; \n a:=[seq(i,i=1..N)]:\n plst:=[a] :\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op(plst)]:\n \+ end do:\n end proc:\n#### prepare combinatorics for L1:\n fun1:=p roc(a1) a1 end proc:\n for i from 1 to N1 do\n fun1(i):=L1[i];\n \+ end do:\n#### here is the old code for the poweset \n# a:=[seq(i,i=1. .N1)]:\n# pList1:=[a]:\n# for i in a do\n# pList1 := [op(subs(i = NULL,pList1)), op(pList1)]:\n# end do:\n####\npList1:=genPS(N1); \n PN1:=nops(pList1)+1; ## added 1 here\n pList1:=sort(pList1,(a,b)-> evalb(nops(a)<=nops(b)));\n pSgn1 :=[seq((-1)^(add(pList1[i][m]-m,m=1 ..nops(pList1[i]))),i=1..PN1-1)];\n#### prepare combinatorics for L2: \n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n fun2(i): =L2[i];\n end do:\n#### here is the old code for the poweset \n# a:= [seq(i,i=1..N2)]:\n# pList2:=[a]:\n# for i in a do\n# pList2 := [ op(subs(i = NULL,pList2)), op(pList2)]:\n# end do:\n####\npList2:=gen PS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:=sort(pList 2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pList2[i][ m]-m,m=1..nops(pList2[i]))),i=1..PN2-1)];\n#### cup tangle of the rota -stein sausage tangle\n cup:=proc(lst1,lst2,coB,nameB)\n local i; \n if nops(lst1)<>nops(lst2) then return 0 end if;\n if lst1=[] \+ then return 1 end if;\n if nops(lst1)=1 then return coB*nameB[lst1[ 1],lst2[1]] end if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],lst2[i]]*cu p(lst1[1..-2],subs(lst2[i]=NULL,lst2),coB,nameB)\n \+ ,i=1..nops(lst2))\n end pro c:\n################################################################## ################# \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms which \+ are potentially non zero in the cup(..) tangle #\n#################### ###############################################################\n max _grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n pos1:= 0:\n for j from 0 to N1 do # for all j-vectors of pList1\n F1:=N1!/ ((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grade-j) do # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N2!/((N2-i) !*i!);\n for n from 1 to F1 do\n for m from 1 to F2 do \n res :=res+\n pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup(map(fun1,p List1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n make clibasmon([op(map(fun1,pList1[pos1+n])),op(map(fun2,pList2[PN2-pos2-m] ))])\n end do:\n end do:\n pos2:=pos2+F2;\n end do:\n \+ pos1:=pos1+F1;\n end do: \nreturn reorder(res); ## note that cmulRS INCLUDES already reorder !!\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 267 19 "No. 28. Procedure " }{TEXT 312 7 "cmulgen" }{TEXT 313 47 " is just a place holder for a Clifford product." }{TEXT -1 1 "\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 557 "cmulgen:=proc() global _default_Cl ifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2003 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: November 1, 2002`;\n################################ #############\nif _default_Clifford_product <> 'cmulgen' then\n retu rn _default_Clifford_product(args)\nelse \n if _warnings_flag then\n WARNING(\"to assign Clifford product, execute 'useproduct' with arg ument cmulRS, cmulNUM, or cmul_user_defined first\");\n end if;\n \+ return 'cmulgen'(args);\n end if; \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 268 25 "No. 29. Wrapper function " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clifford product given by cmulNUM, cmulRS, or other p rocedure such as 'cmulgen'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1378 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2003 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: November 1, 2002`;\n##################################### ########\n if type(op(procname),procedure) then\n lname:=`B`;\n e lse\n lname:=op(procname);\n end if;\n if member(0,[args]) then \+ return 0 end if;\n if nargs <=1 then return args end if;\n if nargs \+ = 2 then\n##########################################################\n ### Speed-wise it makes no difference whether cmulgen or #\n### _defau lt_Clifford_product is used in the following. # ##################### #####################################\n return clicollect(clibilinear (eval(args[1]),eval(args[2]),cmulgen,lname)); \n end if;\n###### <=== do NOT use 'procname' in the next line this will not work\n########## ################################################\n### Speed-wise it ma kes no difference whether cmulgen or #\n### _default_Clifford_product \+ is used in the following. # ######################################### #################\nif not type(_default_Clifford_product,procedure) th en \n error \"global variable _default_Clifford_product must be assi gned a procedure so that 'cmul' could proceed beyond this point. Sorry . For help see ?cmul.\" \nend if;\n return procname(clibilinear(ev al(args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend p roc:\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of \+ " }{TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctly uses -K for index. When K has been assigned a matrix, use\n&c[''K'']( e1,e2) and &c[''-K''](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1,e 2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2304 "`&m`:=proc() local NP,ARGS,coB,nameB,lname, decindex,flagdec;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: November 1, 2002`;\n############################################# \n#######################################\n### Works when &c[''K''] or &c[''-K''] is entered and K is a matrix\n############################ ###########\nflagdec:=true:\nif type(op(procname),procedure) then\n \+ if type([args],listlist) then\n if type(op(args),array) then\n \+ WARNING(\"enclose index in double quotes as in &c[''B''] or &c[' '-B''] when B has been assigned a matrix to avoid the following:\");\n return 'procname(args)';\n end if;\n else coB:=1:\n \+ nameB:=`B`:\n lname:=`B`:\n ARGS:=[args]:\n flagde c:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,name)) then\n coB:=op(select(t ype,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(lnam e)\},name));\n else\n coB:=1:\n nameB:=lname:\n \+ end if;\n flagdec:=false:\n end if;\n########################## #############\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif typ e([args],listlist) then\n if type(op(args),function) then\n ARG S:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n \+ if type(nameB,`&*`(numeric,name)) then\n coB:=op(select(t ype,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(name B)\},name));\n end if;\n elif type(op(args),`&*`(numeric,funct ion)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(type, nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \"u nable to determine index or wrong index, use name in double quotes as \+ in &c[''B''] or &c[''-B'']\"\n end if;\nelif\n type([args],list) \+ then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nelse \n error \"cannot determine arguments and/or index from arguments\" \n end if;\nreturn coB,nameB,[ARGS];\nend proc:\n##################### ################\nif flagdec then \n coB,nameB,ARGS:=decindex(args); \n lname:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) th en return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn cm ul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " tha t allows user to select which procedure is used to compute Clifford pr oduct." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1257 "usepr oduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_Cliff ord_product; #,cmulgen;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 1, 2002`;\n####################################### ######\n############################################################## #####\n###This procedure uses global variable _default_Clifford_produc t #\n################################################################ ### \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defined\}) then \n WARNING(\"expecting one of the following Clifford products : cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\nif memb er(name,\{cmul_user_defined\}) and not type(name,procedure) then\n W ARNING(\"no computations with cmul can be peformed yet since cmul_user _defined has not been defined as procedure. Select cmulRS, cmulNUM, or a new procedure as argument to useproduct.\");\n _default_Clifford_ product:=name;\nreturn NULL;\nend if;\n############################### #\n_default_Clifford_product:=name; #change value of _default_Clifford _product \n################################\nwstr:=cat(\"cmul will use \",name,\"; for help see pages ?cmul, ?Clifford:-intro, or ?\",name); \nWARNING(wstr);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 32 . Procedure " }{TEXT 320 5 "cmulQ" }{TEXT -1 20 " and its infix form \+ " }{TEXT 321 3 "&cQ" }{TEXT -1 514 " is a special version of 'cmul' an d '&c'. It gives the Clifford multiplication in the Clifford algebra \+ of the quadratic form Q related to the symmetric part g of B as Q(x) = g(x, x) = B(x, x) where B = g + A (A is the alternating part of B). \+ Like 'cmul', it works now in all dimensions 1 through 9. Via the proc edure 'rmulm' described below in (32), this multiplication can also be applied to matrices with entries in a Clifford algebra.\n\nThis proce dure can now accept an optional index which could be K or -K. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Propo sed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Than ks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 158 "Typical use: cmulQ(e1 + e2 + 2*Id, e3we4 + e6); or (e1 + e2) &cQ \+ (2*e2we3 + e4); or &cQ(e1, e2, e3); \n cmulQ(e1 we2+e2,e3+e4,e5-Pi*Id); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1423 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2003 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n######################################## #####\n####################################\nif type(op(procname),proc edure) then\n lname:=`B`;\nelse\n lname:=op(procname);\nend if; \n####################################\nif member(0,[args]) then retur n 0 end if;\n####################################\nSxy:=map(op,map(cli terms,\{args\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers')); \nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return cmul[lname](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when bot h x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=l inalg[coldim](evalm(lname)):\n if m>N then \n error \"input con tains index larger than size of bilinear form %1\",lname \n end if: \nend if:\n################################\nif type(lname,\{name,symb ol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return c mul[linalg[diag](L)](args);\nelif \n type(lname,`&*`(numeric,\{name, symbol,array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},num eric));\n nameB:=op(select(type,\{op(lname)\},\{name,symbol,array,ma trix\}));\n L:=seq(coB*nameB[ii,ii],ii=1..m);\n return cmul[linalg [diag](L)](args); \nelse\n error \"index of unexpected type has bee n found in cmulQ\"\nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 272 29 "No. 33. Ampersand version of " }{TEXT 322 5 "cmulQ" }{TEXT 323 222 ". This version can accept index B and -B. When B has been defined as matrix, use\n&cQ[''B''](e1,e2) and &cQ[''-B''](e1,e2) . Otherwise, use &cQ[B](e1,e2), &cQ[-B](e1,e2) or &cQ(e1,e2). \n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 34. Procedu re " }{TEXT 324 10 "scalarpart" }{TEXT -1 137 " computes the scalar pa rt of the given Clifford polynomial. For example, scalarpart(e1 + e2 we3) = 0 but scalarpart(2*Id + e2we3) = 2. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: scalarpart (2*Id + e1 + e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 375 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: November 1, \+ 2002`;\n#############################################\na1:=simplify(a) :\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1):\nr eturn coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. \+ 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes th e k-vector part of the given Clifford polynomial u where k is a nonneg ative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. Wh en k = 0 then the procedure returns the scalar part of u times 'Id', e .g., vectorpart(2*Id + 3*e2we3, 0) = 2*Id. Note that vectorpart(2*Id \+ + e1we2, 0) equals 2*Id while scalarpart(2*Id + e1we2) = 2. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "Typic al use: vectorpart(e1 + e2we3 + e3, 1); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 570 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: November 1, 2002`;\n##################### ########################\na1:=simplify(a):\nif maxgrade(a1) < a2 then \+ return 0 end if;\n K:=proc() if maxgrade(args[1])=a2 then true else \+ false end if end proc:\nif type(a1,`+`) then p:=select(K,a1) elif\n \+ maxgrade(a1)<>a2 then p:=NULL else \n p:=a1 \nend if;\nif p=NULL the n return 0 else return p end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 36. Procedure " }{TEXT 326 4 "cexp" }{TEXT -1 236 " c omputes Clifford exponential of a Clifford number in Cl(B) up to the o rder specified by the second argument which is a nonnegative integer \+ n. It n = 0 then this procedure returns 'Id'. It can accept another ar gument such as B or -B. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 185 "Typical use: cexp(e1we2*t, 3);cexp(e1we2*t, \+ 3,K);\n cexp((e1 + e1we2)*t, 4); cexp((e1 + e1we2) *t, 4,-K); \n cexp(e1we2, 3); cexp(e1 + e1we2, 4,K );\n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 1359 "cexp:=proc(p::\{numeric ,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,an s,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2003 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n################################## ###########\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname :=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,a rray\}) then\n coB:=1:\n nameB:=args[3];\n lname:=ar gs[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array \})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=arg s[3]:\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nelse\n error \"two or thr ee arguments expected in cexp. See ?cexp for more help.\"\nend if;\n## ##############################\nk:='k':\nif type(p,\{numeric,cliscalar \}) then return (add(p^k/k!,k=0..N)) end if;\nif evalb(vectorpart(p,0) =p) then \n pp:=scalarpart(p);\n return ((add(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n eli f N=1 then return Id+pp; \n else \n ans1:=cexp(pp,N-1,lname); \n ans2:=cexp(pp,N-2,lname);\n ans:=ans1+cmul[lname](((ans 1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure " }{TEXT 327 5 "cexpQ " }{TEXT -1 257 " computes Clifford exponential of a Clifford number i n Cl(Q) up to the order specified by the second argument which is a n onnegative integer n. It n = 0 then this procedure returns 'Id'. This procedure can also accept an optional argument such as B or -B." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "Typi cal use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2)*t, 4);\n \+ cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e1we2)*t, 4,K);\n \+ cexpQ(Id+2*e1we3,4); or cexpQ(e1 + 2*e1we2, 4,-K);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1373 "cexpQ:=proc(p::\{numeric,clis calar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,ans,ans 1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 1, 2002`;\n####################################### ######\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B` : \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,array \}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3 ];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) \+ then\n coB:=op(select(type,\{op(args[3])\},numeric));\n na meB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]: \n else \n error \"wrong type of third argument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n error \"two or three \+ arguments expected in cexpQ. See ?cexpQ for more help.\"\nend if;\n### #############################\nk:='k':\nif type(p,\{numeric,cliscalar \}) then return (add(p^k/k!,k=0..N)) end if;\nif evalb(vectorpart(p,0) =p) then \n pp:=scalarpart(p);\n return add(pp^k/k!,k=0..N)*Id \ne nd if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n elif N= 1 then return Id+pp; \n else \n ans1:=cexpQ(pp,N-1,lname); \n ans2:=cexpQ(pp,N-2,lname);\n ans:=ans1+cmulQ[lname] (((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc :\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Procedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponential of a Clifford n umber u up to the order specified by the second argument which is a n onnegative integer n. It returns 'Id' when n = 0. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "Typical use: wexp( e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 610 "wexp:= pr oc(p::\{cliscalar,clibasmon,climon,clipolynom\},N::nonnegative) \nloca l pp,power,cu,i;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: November 1, 2002`;\n############################################# \n if nargs<>2 then error \"two parameters are needed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then return 1 elif\n N=1 then ret urn 1+clisort(pp) end if;\n power:=pp;\n cu:=1+pp;\n for i from 2 t o N do\n power:=wedge(power,pp);\n cu:=cu + power/i!;\n end d o;\n return subs(Id=1,clicollect(clisort(cu)));\n end proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " }{TEXT 329 9 "rever sion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in its argument and it is always a Clifford algebra anti-au tomorphism. When the antisymmetric part of B is not zero, 'reversion' does not preserve the multilinear structure of the algebra because it mixes grades, i.e., it does not preserve the gradation of the exterio r algebra. This procedure can now take a third optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 53 "Typical use: reversion(2*e1we2 + 4*Id - e3we4we5); \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 2639 "reversion:=proc(a1::\{cliscalar, clibasmon,climon,clipolynom,matrix\}) \n local ind,expr,wtp, ptw,lname,flagindexed;\n global _scalartypes,B;\noptions `Co pyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: November 1, 2002`;\n##### ########################################\nif hastype([args[1]],cliprod ) then \n error \"in order to handle 'type/cliprod', load in package Cliplus\" \n end if;\n############################\nif type(a1,clisca lar) then return a1 end if;\n############################\nif nargs=1 \+ then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and type( args[2],\{symbol,name,array,matrix,`&*`(algebraic,name)\}) then\n l name:=args[2];\n flagindexed:=true:\nelse error \"only one or two a rguments are expected\"\nend if;\n############################\n### Au xiliary function that converts wedges to Clifford products: wedge ->> \+ Clifford product\n############################\nwtp:=proc(a1,lname) lo cal ind,i,arg,rdmon,eq1,ans; global _scalartypes; \nif type(a1,\{`+` ,`*`\}) then return (map(wtp,a1,lname)) \n elif type(a1,_scalartypes ) then return a1\n elif type(a1,symbol) and SearchText(w,a1)=0 then \+ return a1\n elif type(a1,symbol) and not member(length(a1),\{5,8,11, 14,17,20,23,26\}) \n then return a1 \nend if;\nrdmon:=reorder(a 1):\nind:=Clifford:-extract(a1,'integers'):\ni:='i':\narg:=[seq(cat(e, op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(arg))=simplify(eval(cmul[ln ame](op(arg))));\nif a1=rdmon then ans:=simplify(solve(eq1,a1)) \n \+ else ans:=-simplify(solve(-eq1,-rdmon)) \nend if;\nif nops( ind) < 4 then return ans else return wtp(ans,lname) end if;\nend proc: \n############################\n### Auxiliary function that converts C lifford products to wedge: Clifford products ->> wedge\n############## ##############\nptw:=proc(a1,lname) local i,arg,revarg; global _scalar types; \nif type(a1,\{`+`,`*`\}) then return (map(ptw,a1,lname)) \n \+ elif type(a1,_scalartypes) then return a1 \n elif type(a1,symbol) an d SearchText(e,a1)=0 then return a1 \n elif type(a1,symbol) and leng th(a1)=2 then return a1 \n elif type(a1,symbol) and not member(lengt h(a1),\{2,4,6,8,10,12,14,16,18\})\n then return a1 \n end if;\n i:='i':\narg:=[seq(cat(e,substring(a1,2*i..2*i)),i=1..(length(a1)/2))] ;\nrevarg:=[seq(arg[nops(arg)-i],i=0..(nops(arg)-1))];\nreturn expand( eval(cmul[lname](op(revarg))))\nend proc:\n########################### ###\n### Now the actual function:\n##############################\nif \+ type(a1,matrix) then return map(reversion,a1,lname) end if;\nexpr:=ptw (expand(wtp(a1,lname)),lname);\nexpr:=expand(displayid(expr)):\nreturn clisort(expr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40. \+ Procedure " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates con jugation in the Clifford algebra. It is linear in its argument. Note \+ that 'conjugation' is defined as a composition of 'reversion' and 'gra deinv'. Hence, it does not preserve the multivector gradation when th e antisymmetric part of B is non-zero. It can now accept optional arg ument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjugation(e1 + 4*e2we3); " }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 823 "co njugation:=proc(a1::algebraic) local lname;global B;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 1, 2002`;\n########## ###################################\nif nargs=1 then\n lname:=`B`; \nelif nargs=2 and type(args[2],\n \{symbol,name,array,matrix,`&*` (numeric,\{symbol,name,array,matrix\})\}) then\n lname:=args[2];\ne lse error \"only one or two arguments are expected\"\nend if;\n####### ####################\nif type(a1,matrix) then return map(procname,a1,l name) elif\n type(a1,cliscalar) then return a1 elif\n type(a1,\{cl ibasmon,climon,clipolynom\}) then\n return eval(gradeinv(revers ion(a1,lname)))\nelse \n error \"wrong input type: input must be of \+ type cliscalar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if; \nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c_conjug" }{TEXT -1 72 " calculates complex conjugate in a complexified Clifford algebra; thu s, " }}{PARA 258 "" 0 "" {TEXT -1 80 " \+ c_conjug(u) = c_conjug(a + I*b) = a - I*b " }}{PARA 258 "" 0 "" {TEXT -1 140 "where a and b are in the real Clifford algebra and `I` i s the imaginary unit, i.e., I = sqrt(-1). This procedure is linear in \+ its argument. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 51 "Typical use: c_conjug((1 + 2*I)*e1 - 3*I*e1we2); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 697 "c_conjug:=proc(a1::algebraic) loca l ba,co,terms,t,i;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: November 1, 2002`;\n############################################ #\nif type(a1,matrix) then return map(procname,a1) elif\n type(a1,cl iscalar) then return conjugate(a1) elif\n type(a1,\{clibasmon,climon ,clipolynom\}) then\n t:='t':\n ba:=cliterms(a1);\n \+ co:=[coeffs(a1,ba,'t')];\n terms:=[t];i:='i':\n retur n clisort(add(conjugate(co[i])*terms[i],i=1..nops(co)))\n else \nerr or \"wrong input type: input must be of type cliscalar, clibasmon, cli mon, clipolynom, or 'matrix'\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 42. Procedure " }{TEXT 332 6 "buildm" }{TEXT -1 863 " builds a matrix for the given element u of the Clifford algebra \+ Cl(B) in the left- or right-regular representation, or under Lie or au tomorphism action with respect to an ordered basis specified by the us er. The element p is entered as the first argument and the basis in t he form of a list is specified as the second argument, e.g., buildm(u, basis). It is also possible to specify options 'left', 'right', 'Lie ', 'auto', 'false, and 'true'. For example, one can find the left-regu lar representation of the algebra on itself or, when Cl(B) is simple a nd isomorphic to a ring of real matrices, one can find matrices repres enting Clifford polynomials in a real basis of a minimal ideal. Howev er, there are new procedures below specifically designed for finding s pinor representations of Clifford algebras in terms of real, complex, \+ and quaternionic matrices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuildm(e1, [Id, e1, e 2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'right'); buildm(e1, [Id, \+ e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2],'false'); buil dm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm(e1, [Id, e1, e2, e1w e2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2967 "bui ldm:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::list(\{cliscalar,clibasmon,climon,clipolynom\}))\nlocal A,L,N,a11 ,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,flag;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 1, 2002`;\n########## ###################################\nflag:=true:\nif nargs=2 then a33: ='left' end if;\nif nargs=3 then \n if member(args[3],\{'true','fals e'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left','right','Lie','auto'\} ) \n then a33:=args[3]\n else \+ error \"third optional argument must be 'left', 'right', 'Lie', 'auto' , 'true', 'false'\"\n end if; \nend if;\nif nargs=4 then\n if memb er(args[3],\{'left','right','Lie','auto'\}) and member(args[4],\{'fals e','true'\}) then\n a33:=args[3]; \n flag:=args[4];\n else \n error \"third optional argument must be 'left', 'right ', 'Lie', 'auto', and the fourth optional argument must be 'false' or \+ 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many argume nts. See ?buildm for more help.\" end if;\n########################### ######################\nif flag then \nA:=linalg[genmatrix](args[2],cb asis(maxindex(args[2])));\nif linalg[rank](A) < nops(args[2]) then \n \+ error \"elements of the list %1 are linearly dependent. Apply 'findb asis' to this list first.\",a2 \nend if;\nend if;\n###local procedure \nnontrivial:=proc(S::\{set(\{relation,algebraic\}),list(\{relation,al gebraic\})\}) \nlocal istrivial;\nprintlevel:=2:\nistrivial:=proc(x) i f type(x,relation) then evalb(x) else evalb(x=0) end if end;\nremove(i strivial,S)\nend proc:\n### \nL:=a2:N:=nops(L):xm:=array(1..N,1..N):\n if a33='left' then \n for i from 1 to N do \n eq||i:=clicoll ect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1..N))) \n end do;\neli f a33='right' then \n for i from 1 to N do \n \+ eq||i:=clicollect(expand(cmul(L[i],a1)-add(xm[j,i]*L[j],j=1..N)))\n \+ end do;\nelif a33='Lie' then\n for i from 1 to N do\n e q||i:=clicollect(expand(cmul(L[i],a1)-cmul(a1,L[i])-add(xm[j,i]*L[j],j =1..N)))\n end do;\nelif a33='auto' then\n a11:=cinv(a1):\n \+ for i from 1 to N do \n eq||i:=clicollect(ex pand(cmul(cmul(a1,L[i]),a11)-add(xm[j,i]*L[j],j=1..N)))\n end do; \nelse error \"third optional argument must be 'left', 'right', 'Lie', or 'auto'\"\nend if;\n############################################### ###########\nLbasis:=[op(`union` (seq(cliterms(L[i]),i=1..N)))];\nfor \+ i from 1 to N do \n for j from 1 to nops(Lbasis) do \n neq[i ,j]:=coeff(eq||i,Lbasis[j])=0 \nend do;\nend do;\nvars:=convert(evalm( xm),set):sys:=map(op,\{entries(neq)\});\nsys:=nontrivial(sys): #elimin ate trivial equations\nsol:=solve(sys,vars);\nif sol=NULL then \n er ror \"no matrix represents %1 in the basis %2 under the %3 action\",a1 ,a2,a33; \nend if;\nassign(sol);\nreturn evalm(xm);\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 43. Procedure " }{TEXT 333 9 "findb asis" }{TEXT -1 680 " finds a basis in a linear vector space spanned b y a set of Clifford polynomials entered as a list. The procedure is u sed, for example, when finding a basis for a spinor space S considere d as a minimal left or right ideal in Cl(B) generated by a primitive i dempotent f. To speed up computations, it is advisable to a standard C lifford basis for Cl(B) in the form of a list of basis monomials as th e second argument. If only one list is specified, 'findbasis' determi nes a suitable Clifford basis itself but it takes twice as much time t hen since it creates a Clifford basis by using 'cbasis(maxindex)' wher e 'maxindex' is the maximum index found among the elements of the list ." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use: findbasis([2*e1+e2, e2+e1we2,e1we2],[Id,e1,e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1428 "findbasis:=proc(a1,a2) local L,clibasis,M,i,m,r,v,S; \nglobal \+ _prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: No vember 1, 2002`;\n#############################################\nif ev alb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{cliba smon,climon,clipolynom\})) or \n type(a1,set(\{c libasmon,climon,clipolynom\}))) then\nerror \"argument of type list/se t(\{clibasmon,climon, or clipolynom\}) was expected\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,climon,clipolynom\})) or \+ \n type(a1, set(\{clibasmon,climon,clipolynom\}))) and \n \+ (type(a2,list(clibasmon)) or type(a2,set(clibasmon)))) or nar gs>2 then\nerror \"arguments of type list/set(\{clibasmon,climon,clipo lynom\}) and list/set(clibasmon) were expected\" \nend if;\nend if;\ni f nops(a1)=1 then return a1 end if;\nL:=sort(map(displayid,convert(a1, list)),bygrade):\nif nargs=2 then clibasis:=sort(convert(a2,list),bygr ade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),lis t),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[ra nk](M):m:=linalg[rowdim](M):\nfor i from 1 to m do v[i]:=linalg[row](M ,i) end do;\nS:=[v[1]]:\nfor i from 2 to m while nops(S) < r do \n \+ if linalg[rank](linalg[stackmatrix](op(S),v[i]))=nops(S)+1 \n th en S:=[op(S),v[i]] \n end if\nend do;\nreturn [seq(L[i],i=map(op,S) )]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 44. Procedure " }{TEXT 334 12 "minimalideal" }{TEXT -1 143 " calculates a real basis f or a left S=Cl(B)f or right S=fCl(B) minimal ideal in the algebra Cl(B ) where f is a primitive idempotent in Cl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "The first argument of \+ the procedure is an ordered list of basis monomials sorted bygrade, e. g., a Clifford basis generated by the procedure 'cbasis'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 198 "Note: to s ort a list L by grade one may use sort(L, bygrade) where 'bygrade' i s a new procedure in this package described below. The output from th e procedure 'cbasis' is already sorted that way." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argument is the idempotent f. If the idempotent f is the same as the one stored \+ under clidata()[4] then 'minimalideal' uses the generators of S stor ed under clidata()[5] to generate the real basis and it returns the st ored list clidata()[5] as the second list in its ouput. If f does n ot equal clidata()[4] then complete computations are performed but th ey may take longer. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 129 "It is assumed that the numerical values of B have been specified.\n\nThe procedure returns a list consisting of two ord ered lists: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 91 "(1) the first list contains the real basis of S written \+ as expanded Clifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 106 "(2) the second list contains basis m onomials from the standard basis in Cl(B) which generate the \+ " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by multiplying f o n the left or on the right depending whether S=Cl(B)f or S=fCl(B). \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 257 260 "There is a one-to-one correspodence between the two ordered lists .\n\nTypical use: minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3 ],(1/2)*(Id+e3),'left');\n minimalideal([Id,e1, e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'right');\n" } {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2246 "minimalideal: =proc(a1,a2,a3) \nlocal L,gens,m,flag1,f,flag_left,data,SB,g,SBgens,pq ,p,q,l,ni,realdim,dimoverK,cb,N,bel; \nglobal B,_shortcut_in_minimalid eal,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : November 1, 2002`;\n#############################################\ni f not type(B,diagmatrix) then \n error \"bilinear form B has not bee n assigned a matrix or is not diagonal\" \nend if; \nif not _prolevel \+ then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) then\n \+ error \"first argument must of type list(\{clibasmon,climon,c lipolynom\})\" \n elif not type(a2,'primitiveidemp') then \n \+ error \"second argument must be a primitive idempotent\" \n \+ elif not member(a3,\{'left','right',\"left\",\"right\"\}) th en\n error \"third argument must be 'left', or 'rig ht'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\nif member(a3,\{'l eft',\"left\"\}) then flag_left:=true else flag_left:=false end if;\ng :='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimalideal then\n m: =maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 then\n \+ data:=clidata():\n if eval(eval(data[4]))=eval(f) or eval(eval( data[4]))=gradeinv(f) then\n SBgens:=data[5]:\n if fla g_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n retu rn [SB,SBgens,a3];\n end if;\n end if;\nend if; \n#If can't \+ use the shortcut, perform necessary computations.\npq:=Bsignature():\n p:=pq[1]:q:=pq[2]:\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member((p-q) mo d 8,\{0,1,2\}) then \n realdim:=2*ni; \n dimoverK:=2*ni; \ne lif member((p-q) mod 8,\{3,7\}) then \n realdim:=4*ni; \n di moverK:=2*ni; \nelse\n realdim:=4*ni; \n dimoverK:=ni \nend \+ if;\ngens:=clidata()[5]: #put elements from clidata()[5] first in L\nL :=remove(member,L,gens):\nL:=[op(gens),op(L)]:\nSB:=[f]:SBgens:=[Id]:c b:=remove(member,L,[Id]); \nfor g in cb while nops(SB) < realdim do\n \+ N:=nops(SB):\n if flag_left then bel:=cmulQ(g,f) else bel:=cmulQ (f,g) end if; \n SB:=findbasis([op(SB),bel]); \n if nops(SB)>N \+ then SBgens:=[op(SBgens),g] end if;\nend do:\nreturn [SB,SBgens,a3];\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedure " } {TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis for a field K. \+ The field K is the field of the spinor space S = Cl(B)f or S = fCl(B) \+ of the given Clifford algebra Cl(B). It is isomorphic to the reals, \+ or to the complexes, or to the quaternions according to whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 205 "Assuming that the bilinear form B has been d efined, the first argument of the procedure is expected to be the same as the output from the procedure 'minimalideal'. The second argument is the idempotent f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 225 "The procedure eliminates from the list of basis e lements in the real ideal space nilpotent elements and leaves only tho se whose square modulo f is either +1 or -1. It returns those element s as the first list in its output. " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 200 "If the primitive idempotent f is \+ the same as the one stored under clidata()[4] and if the generators of the real basis in the minimal ideal S match those stored under clidat a()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses gene rators of K stored under clidata()[6] and returns them as the second \+ list in its ouput. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 178 "Thus, the second list in the output contains gene rators (Clifford basis monomials) of the elements in the first list. \+ Elements of the two lists are in one-to-one relationship. " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[diag](1,-1): clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left'); \n \+ Kfield(sbasis,f);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4296 "Kfiel d:=proc(a1::list(\{list,string,symbol\}),a2::clipolynom) \nlocal SB,ge ns,f,ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,dimen,Kbasis, Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n# ############################################\n#### Local procedure nee ded only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f,mi,clibas,c libas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:=max(op(map(m axindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\nif type(B,matr ix) then gens:=subsop(1=NULL,clidata()[6]);\n clib as:=remove(member,clibas,gens):\n clibas:=[op(gens ),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \n if eva lb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \nend do:\nf or x in clibas2 do \nfor y in remove(member,clibas2,[x]) do\nfor z in \+ remove(member,clibas2,[x,y]) do\n if member(cmul(x,f),\{Kbasis[2] ,-Kbasis[2]\}) then \n if member(cmul(y,f),\{Kbasis[3],-Kbasis [3]\}) then\n if member(cmul(z,f),\{Kbasis[4],-Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') then return [x ,y,z]\n end if;\n end if;\n end if;\n end if;\nend do;\nend do;\ne nd do;\nend proc:\n##############################################\nif \+ not _prolevel then\n if not type(a2,'primitiveidemp') then \n e rror \"second argument must be a primitive idempotent\"\n end if;\ne nd if;\nSB:=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n if not member(f,SB) then \n error \"idempotent entered %1 is not a m ember of the first list\",f \nend if;\n###new line here instead of >>> not assigned(B)<<<\nif not type(B,matrix) then \n error \"matrix mus t be assigned to B\" \nend if;\nif side='left' then flag3:=true else f lag3:=false end if;\ndata:=clidata():\nfield:=data[1]:\nif field = 're al' then return [[f],[Id]] \nelif field = 'complex' then \n if _shortcut_in_Kfield then\n f_from_data:=eval(eval(data[4])) :\n fg:=gradeinv(f): \n if member(f_from_data,\{f ,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif flag3 then Kbasis:=[f,seq (cmul(Kgens[i],f),i=2..nops(Kgens))]\n else Kbasis:=[f,seq(cmu l(f,Kgens[i]),i=2..nops(Kgens))] \nend if;\nreturn ([Kbasis,Kgens]) \n end if;\nend if;\n#Do this when shortcut can't be used when field = 'c omplex'\nKdim:=2: \nKbasis:=[f]:Kgens:=[Id]:ff:=[op(data[4])]:n:=nops( ff);\nfor i from 1 to nops(SB) while nops(Kbasis) < Kdim do\n if c mul(gens[i],gens[i])=-Id then\n expr:=gens[i]:\n for k f rom 1 to n while expr<>0 do\n expr:=cmul(ff[n-k+1],expr,ff[ k]);\n end do; \n if expr<>0 then Kbasis:=[op(Kbasis),SB[ i]];\n Kgens:=[op(Kgens),gens[i]] \n end if;\n \+ end if;\nend do;\nreturn [Kbasis,Kgens]\nelif field = 'quaternionic ' then \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:= [op(SB)];\n Kgens:=[op(gens)];\n \+ return [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) th en\n if _shortcut_in_Kfield then\n f_from_data:= eval(eval(data[4])):\n fg:=gradeinv(f): \n \+ if member(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif \+ flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i= 2..nops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\n end if;\n#Do this when shortcut can't be used and field = 'quaternioni c'\nKdim:=4:\nKbasis:=[f]:Kgens:=[Id]:ff:=[op(data[4])]:n:=nops(ff);\n for i from 1 to nops(SB) while nops(Kbasis) < Kdim do\n if cmul(ge ns[i],gens[i])=-Id then\n expr:=gens[i]:\n for k from 1 \+ to n while expr<>0 do\n expr:=cmul(ff[n-k+1],expr,ff[k]);\n end do; \n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]] e nd if;\nend if;\nend do;\n ijk:=T4(Kbasis);\n Kgens:=[Id,op(ij k)]:\nif flag3 then Kbasis:=[f,seq(cmul(g,f),g=ijk)] else \n \+ Kbasis:=[f,seq(cmul(f,g),g=ijk)]\nend if;\nreturn [Kbasis,Kgens]\n else error \"wrong name of the field. See ?Kfield for more help.\" \n end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. Procedu re " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spinor basis for S=Cl(B)f or S=fCl(B) over a field K where K is isomorphic to the reals, or to the complexes, or to the quaternions according to whethe r (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 276 "The first argument is an ordered list \+ SBgens containing generators of a real basis in a minimal ideal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was left or right). T hese generators are found by the procedure 'minimalideal' and are retu rned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the primitive i dempotent f used to generate the minimal ideal Cl(B)f or fCl(B)." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 150 "The \+ third argument is a list FBgens of generators that generate the field \+ K; these generators are returned as a second list by the procedure 'Kf ield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The fourth argument is either 'left' or 'right' depending whet her we deal with the left minimal ideal Cl(B)f or the right minimal id eal Cl(B)f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 434 "If the first three arguments in the input match respecti vely clidata()[5], clidata()[4], and clidata()[6] in that order, i.e ., SBgens=clidata()[5], f=clidata()[4], and FBgens=clidata()[6], the n the procedure finds previously computed generators of S over K which are stored as clidata()[7]. These generators are then used to comput e the K-basis for S=Cl(B)f or S=fCl(B) depending whether the fourth ar gument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Clifford polynomials \+ which give a basis in Cl(B)f or fCl(B) (depending on what was the fou rth argument in the procedure);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 178 "(2) the second list is an ordered list of generators over f which give the elements in the first list. Ther e is a one-to-one correspodence between the elements of the two lists. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 " (3) the third element in the output is either 'left' or 'right' and it matches the fourth argument in the input to the procedure. That elem ent is to remind the user that the basis returned as the first list is for the left or right ideal respectively. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 334 "Typical use: dim:=2:B: =linalg[diag](1,-1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]: \n sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n \+ SBgens:=sbasis[2];FBgens:=fbasis[2];\n s pinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2864 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmon,climon,clipolyno m\},a3::list,a4::\{string,symbol\}) \nlocal flag,flag_left,Kdim,f,SBge ns,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \nglobal B,_shortcut_ in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: November 1, 2002`;\n#################################### #########\nif not type(B,matrix) then \n error \"matrix must be assi gned to B\" \nend if;\nif not _prolevel then\n if not type(a2,'idemp otent') then \n error \"second argument must be an idempotent\" e lif\n not member(a4,\{'left','right',\"left\",\"right\"\}) then \n \+ error \"the fourth argument must be 'left', or 'right'\"\n end i f;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens then return [[f],[Id],a4] end if;\nif a4='left' or a4=\"left\" then flag_l eft:=true else flag_left:=false end if;\ndata:=clidata():\nif _shortcu t_in_spinorKbasis then\n if eval(f)=eval(data[4]) and SBgens=data [5] and FBgens=data[6] then\n SBKgens:=data[7];\n SBKbasis:= []:\n g:='g':\n if flag_left then SBKbasis:=[seq(cmulQ(g,f), g=SBKgens)]\n else SBKbasis:=[seq(cmulQ(f,g),g=SBKge ns)]\n end if; \n return [SBKbasis,SBKgens,a4];\n end \+ if;\nend if; \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif flag_left then \+ SB:=[seq(cmulQ(g,f),g=SBgens)] \n else SB:=[seq(cmulQ(f,g) ,g=SBgens)]\nend if;\nif Kdim=1 then return [SB,SBgens,a4] end if;\nm: =max(op(map(maxindex,SBgens)));\nposs:=cbasis(m);\nSBKgens:=[Id]:\ng:= 'g':\nif flag_left then SB:=remove(member,SB,[seq(cmul(f,g),g=FBgens)] )\n else SB:=remove(member,SB,[seq(cmul(g,f),g=FBgens)])\n end if;\nposs:=remove(member,poss,FBgens);\nfor g in poss while nops(S B)>0 do\n if flag_left then \n for i from 1 to Kdim do p[i]:= cmul(g,f,FBgens[i]) end do;\n else \n for i from 1 to Kdim do p[i]:=cmul(FBgens[i],f,g) end do;\n end if; \n for i from 1 to Kdim do\n flag[1,i]:=member(p[i],SB): \n flag[2,i ]:=member(-p[i],SB):\n end do;\n if Kdim=2 then \n if ( flag[1,1] or flag[2,1]) and (flag[1,2] or flag[2,2]) then\n S B:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n SBKgens:=[op( SBKgens),g]\n end if:\n else\n if (flag[1,1] or flag[2,1 ]) and \n (flag[1,2] or flag[2,2]) and\n (flag[1,3] or flag[2,3]) and\n (flag[1,4] or flag[2,4])\n then\n \+ SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[3],p[4],-p[4]]) :\n SBKgens:=[op(SBKgens),g]\n end if:\n end if;\n \+ if flag[1,1] then SBKbasis:=[op(SBKbasis),p[1]] else\n \+ SBKbasis:=[op(SBKbasis),-p[1]] \n end if;\n end do;\ng:='g ':\nif flag_left then SBKbasis:=[seq(cmul(g,f),g=SBKgens)] else\n \+ SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend if;\nreturn [SB Kbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. \+ 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes th e square of a basis element u in a left or right minimal ideal Cl(B)f \+ or fCl(B) entered as the first argument modulo a primitive idempotent f entered as the second argument. The procedure doesn't check wheth er f is primitive or not. Thus, the procedure returns 1 or -1 dependi ng whether cmul(u,u) = f or cmul(u,u) = -f. The procedure returns 0 \+ if u is a nilpotent element." }}{PARA 258 "" 0 "" {TEXT -1 115 "\nThis procedure is needed to identify/verify squares of the basis elements \+ in the field K of the spinor ideal S. \n" }}{PARA 258 "" 0 "" {TEXT -1 54 "Typical use: squaremodf((1/2)*(Id+e1),(1/2)*(Id+e1);\n " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 783 "squaremodf:=proc(a1::\{clibasmon,c limon,clipolynom\},a2::idempotent) \nlocal p;global B;\noptions `Copyr ight (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: November 1, 2002`;\n######## #####################################\nif nargs<>2 then \n error \"t wo arguments needed of type clibasmon, or climon, or clipolynom, and ' idempotent'\" \nend if;\nif a1=a2 then return 1 elif\n not type(B,ma trix) then error \"matrix must be assigned to B\" \nend if;\np:=cmul(a 1,a1):\nif expand(p-a2)=0 then return 1 elif\n expand(p+a2)=0 then r eturn -1 elif\n (p=0 or type(a1,nilpotent)) then return 0 else \+ \n error \"either element %1 is not a basis element or it does not belong to the spinor space Cl(Q)f (or fCl(Q))\",a1 \nend if;\nend pr oc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48. Procedure " }{TEXT 338 8 "RHnumber" }{TEXT -1 76 " gives the Radon-Hurwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 504 "RHnumber:=proc(a1::integer)\noptions `Copyright (c) \+ 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: November 1, 2002`;\n################# ############################\nif member(a1,\{0,1,2\}) then return a1 e lif\n a1=3 then return 2 elif\n member(a1,\{4,5,6,7\}) then return 3 elif\n a1>=8 then return RHnumber(a1-8)+4 elif\n a1<0 then retu rn RHnumber(a1+8)-4 else\n error \"wrong value of the argument. See \+ ?RHnumber for more help.\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 " " {TEXT -1 19 "No. 49. Procedure " }{TEXT 339 7 "clidata" }{TEXT -1 304 " returns a list containing basic information about the orthogonal Clifford algebra Cl(Q) of the given bilinear form B (assumed to have \+ been diagonalized). The procedure must be called with B, or with a si gnature of B given as a list [p,q], or simply as clidata() (currently \+ defined B will then be used)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "It returns a list with the following e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 187 "(a) the first entry is the string 'real', 'complex', or 'quat ernionic' depending whether the spinor representation of Cl(Q) is over the field K of the reals, complexes, or quaternions;\n" }}{PARA 258 "" 0 "" {TEXT -1 305 "(b) the second entry is the dimension of the spi nor representation over the field K;\n\n(c) the third entry is 'simple ' or 'semisimple' depending on the structure of the algebra;\n\n(d) th e fourth entry is a primitive idempotent f which may be used to gene rate a left or right minimal ideal in the algebra." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 "NOTE: the idempoten ts are stored here in an unevaluated form so that they could be easily recognized as Clifford products of simpler projection operators. The number of factors in these products is determined by the value of q - RHnumber(q-p).\n\n(e) the fifth entry is a list of basis monomials \+ ordered by grade which generate Cl(Q)f and fCl(Q).\n\n(f) the sixth en try is a list of basis monomials ordered by grade which give a basis f or K (this is in terms of these monomials that matrices representing C lifford polynomials will be written by the procedure 'spinorKrepr').\n " }}{PARA 258 "" 0 "" {TEXT -1 92 "(g) the seventh entry is a list of \+ basis monomials ordered by grade which generate S over K." }}{PARA 258 "" 0 "" {TEXT -1 139 "\nIf the procedure is called as 'clidata()' \+ then it returns information about the Clifford algebra of the currentl y defined bilinear form B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 81 "Typical use: clidata(); clidata([2,3]); clida ta(B);clidata(linalg[diag](1,1,1));\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 473 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: November 1, 2002`;\n############ #################################\nif nargs=0 then a1:=`B` else a1:=ar gs end if:\nif not type(a1,\{list(nonnegint),matrix\}) then\n WARNIN G(\"to find out about Clifford algebra Cl_\{p,q\} try clidata([p,q]) o r enter ?clidata for more help\");\n return ('procname(args)')\nend \+ if;\n" }}{PARA 258 "" 0 "" {TEXT -1 76 "This is a data file that is re ad in when needed by the procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" }{MPLTEXT 1 0 16600 ":=proc(a 1::\{list(nonnegint),matrix\})\nlocal SBgens,FBgens,SBKgens,p,q,l,ni,K ,dimoverK,dimoverR,numfact,struct,primidemp;\nglobal B;\noptions `Copy right (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`,remember;\ndescription `Last revised: November 1, 2002`; \n#############################################\n#K = field of spinor \+ repesentation, it is R, C, or H depending on [p,q]\n#dimoverK = dimens ion of spinor representation over the field K\n#dimoverR = dimension o f spinor representation over the reals R\n#numfact = number of idempot ent factors in any primitive idempotent\n#SBgens = basis monomials gen erating Cl(Q)f and fCl(Q) over R\n#FBgens = basis monomials providing \+ a basis for K\n#SBKgens = basis monomials generating Cl(Q)f and fCl(Q) over K \n#p = number of +1 in the diagonal form Q of B\n#q = number o f -1 in the diagonal form Q of B\n#struct = structure of Cl(Q) is 'sim ple' or 'semisimple'\n#primidemp = primitive idempotent f to generate \+ Cl(B)f or fCl(B)\nif nargs=0 then\n###new line instead of >>>not assig ned(B)<<<\nif not type(B,matrix) then \n error \"matrix must be assi gned to B\" else\n return clidata(B)\nend if;\nend if; \nif type( args[1],list(nonnegint)) then p:=args[1][1]:q:=args[1][2]: \n elif t ype(args[1],matrix) then \n p:=Bsignature(args)[1]; q:=Bsignatu re(args)[2] \n else \n error \"wrong argument types in 'clida ta'\" \n end if;\nif type(args[1],list(nonnegint)) and (p>9 or q>9) \+ then\n error \"p and q must satisfy 0 <= p,q <= 9\" \nend if;\nl:=fl oor((p+q)/2);ni:=2^(l-1);\nif member((p-q) mod 8,\{0,1,2\}) then \n \+ K:='real'; dimoverR:=2*ni; dimoverK:=2*ni; \nelif member((p-q) mod \+ 8,\{3,7\}) then \n K:='complex'; dimoverR:=2*2*ni; dimoverK:=2*ni ; else\n K:='quaternionic'; dimoverR:=4*ni; dimoverK:=ni \nend if ;\nnumfact:=q-RHnumber(q-p);\nif modp((p-q) = 1,4) then struct:='semis imple' \n else struct:='simple' \nend if;\nprimidemp:=table():SBgens :=table():FBgens:=table():SBKgens:=table():\n######################### >>>DATA<<<#################################\n#Real, simple (13 cases) \nprimidemp[[0,0]]:=Id; #real numbers\nSBgens[[0,0]]:=[Id];\nFBgens[[ 0,0]]:=[Id];\nSBKgens[[0,0]]:=SBgens[[0,0]];\n\nprimidemp[[1,1]]:=(1/2 )*(Id+e1we2);\nSBgens[[1,1]]:=[Id,e1];\nFBgens[[1,1]]:=[Id];\nSBKgens[ [1,1]]:=SBgens[[1,1]];\n\nprimidemp[[2,0]]:=(1/2)*(Id+e1);\nSBgens[[2, 0]]:=[Id,e2];\nFBgens[[2,0]]:=[Id];\nSBKgens[[2,0]]:=SBgens[[2,0]];\n \nprimidemp[[2,2]]:=\n''cmulQ''((1/2)*(Id+e1we3),(1/2)*(Id+e2we4));\nS Bgens[[2,2]]:=[Id,e1,e2,e1we2];\nFBgens[[2,2]]:=[Id];\nSBKgens[[2,2]]: =SBgens[[2,2]];\n\nprimidemp[[3,1]]:=\n''cmulQ''((