{VERSION 6 0 "IBM INTEL NT" "6.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 29 "\nThis is clifford_M11_0 8.mws\n" }}{PARA 258 "" 0 "" {TEXT -1 29 "(Created: December 20, 2007) \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "########################### ##################################################\n# \+ #\n#DISCLAIM ER: #\n # \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Oct onion, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AN D/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANT Y OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIM ITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS F OR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND \+ PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE \+ #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n################################################ #############################\n" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 324 "This is a listing (without examples) o f all procedures in a Maple package called 'CLIFFORD' (Version 11, Co pyright 1995-2008 by Rafal Ablamowicz, Tennessee Technological Univer sity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 11. Us er will know which version he/she is using by using the 'version()' fu nction." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{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 product of p1,p2,...,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p 1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is e xpected 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 diagonal matrix)" } }{PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## minimal polynomial \+ of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponen tial 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 fol lowing procedures can use name K or a numeric multiple 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 of p2 by p1 w.r.t. K\n RC(p1,p2,K); ##right contraction of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 a nd m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "reversion(p,K); ##rever sion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Cliffo rd 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. diagonal 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 "conjugatio n(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing 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 "\nProcedures that define types: `type/ climon`, `type/clipolynom`, `type/climatrix` as well as other procedur es such as 'reorder', 'wedge', etc., have been substantially revised t o improve efficiency and speed of the package. This work has been done together with Bertfried Fauser, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nThis version includes \"Bigebra\" package tha t has been created together with Bertfried Fauser, Universit\"at Konst anz, Konstanz, Germany. Additional help pages have been written and ad ded to the database that explain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 302 "An additional feature in this version is an ability to display and change environmental variables. They can be displayed with proced ure CLIFFORD_ENV.\n\nThis package is made to run under Maple 11. It i s available on a server of the Department of Mathematics, Tennessee \+ Technological University, at: \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " \+ http://math.tntech.edu/rafal/clifford/ " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 130 "In \+ order to create a Maple file 'Clifford.m' containing the 'CLIFFORD' pa ckage, execute this worksheet.\n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">with(Cliff ord); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been loaded because a list wi th Clifford procedures will be displayed on the screen. To check the \+ current version of the package, at the Maple prompt 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@t ntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-356 9" }}{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, CLIFFORD_ENV, Kfield, LC, LCQ, RC, \+ RCQ, RHnumber, adfmatrix, all_sigs, beta_minus, beta_plus, buildm, byg rade, c_conjug, cbasis, cdfmatrix, cexp, cexpQ, cinv, clibilinear, cli collect, clidata, clilinear, climinpoly, cliparse, cliremove, clisolve , clisort, cliterms, cmul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, c ommutingelements, conjugation,ddfmatrix, diagonalize, displayid, extra ct, factoridempotent, find1str, findbasis, gradeinv, init, isVahlenmat rix, isproduct, makealiases, makeclibasmon, matKrepr, maxgrade, maxind ex, mdfmatrix, minimalideal, ord, permsign, pseudodet, q_conjug, qdisp lay, qinv, qmul, qnorm, reorder, reversion, rmulm, rot3d, scalarpart, \+ sexp, specify_constants, spinorKbasis, spinorKrepr, squaremodf, subs_c lipolynom, useproduct, vectorpart, version, 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 information 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 1522 "version:= proc()\noptio ns `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: December 20, 2007`; \nprint(`+++++++++++++++++++++++++++++++++++++++++++`);\nprint(`CLIFFO RD - A Maple 11 Package for Clifford Algebras with \"Bigebra\"`); \npr int(`(Version 10 with environmental variables given by CLIFFORD_ENV()) `);\nprint(`Last revised: December 20, 2007 (Source file: clifford_M11 _08.mws)`);\nprint(`Copyright 1995-2008 by Rafal Ablamowicz (*) and Be rtfried Fauser ($)`);\nprint(``);\nprint(`(*) Department of Mathematic s, Box 5054`);\nprint(` Tennessee Technological University, Cookevi lle, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax: USA (931) 3 72-6353`);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://ma th.tntech.edu/rafal/Cliff8/`);\nprint(`($) Universit\"at Konstanz, Fac hbereich Physik, Fach M678`);\nprint(` 78457 Konstanz, Germany`);\n print(` Bertfried.Fauser@uni-konstanz.de`);\nprint(` http://kalu za.physik.uni-konstanz.de/~fauser/`); \nprint(``);\nprint(`If you are a Clifford algebra pro, assign 'true' to '_prolevel' and see`);\n print(`how much faster your computations will be! But watch your synta x!`);\nprint(`Use 'useproduct' to change value of _default_Clifford_pr oduct in Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmulNUM wh en B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_ENV() t o see current values of environmental variables.`); \nprint(`+++++++++ +++This is CLIFFORD version 11++++++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_con stants" }{TEXT -1 503 " allows user to specify any new symbolic consta nts, e.g., a, b, c, B, e.t.c, which are to be known to Maple. The or iginally known constants are stored in a global, non-protected variabl e 'constants' and must be saved separately, if needed. This procedure is needed when sorting or collecting multivariate Clifford polynomial s containing expressions like 'aa*eiwej' 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 mak e any additional constants of length 2 or more known to Maple as shown below. If these constants of length 2 or more are not defined as Map le constants, then some procedures might yield error messages (althoug h an attempt has been made to avoid this problem). Constants of length one are automatically assumed to be Maple constants. " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: spe cify_constants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have b een added for the Reader's convenience in the sequence of input variab les as in the above example. These spaces are not needed or required b y Maple." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 372 "specify_constants:=proc(a1::anything) global constan ts;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2007`;\n#############################################\nconstants:= op(\{constants,args\});\nprintf(\"Maple now knows the following consta nt(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 cb asis(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 r eturns a list of basis elements in the 2-vector subspace of Cl(4). Bel ow, 'Id' stands for the algebra unit element and 'w' denotes wedge/ext erior product in the Clifford algebra. An option 'even' allows one to \+ create a basis in the even subalgebra of the given Clifford algebra as in cbasis(3, 'even'). In fact, 'even' can be replaced with any name \+ which evaluates to a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1876 "cbasis:=proc(a1::nonnegint,a2::\{string,symbol,nonnegint\})\nloc al i,k,X,XX,YY,L,Leven,Lodd,bas,nxt,ind,start; global choose,e;\noptio ns `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`,remember;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\nif a1>9 then \n error \"first argument must be between 0 and 9 inclusive but rec eived %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:=proc name(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]),odd) then Leven:=[op (Leven),L[i]] else\n Lodd:=[op(L odd),L[i]]\n end if \n end do \n end if; \nif args[2]='even' then return Leven \n elif args[2]='odd' then return Lodd\n else e rror \"second argument must be an integer or a string 'even' or 'odd' \+ but received %1 instead\",args[2]\nend if\nend do \nend if;\nfor k fro m 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 error \"one or two arg uments 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] \nend if \nend if;\nYY: =array(1..nops(XX),[]);start:=1:\nif XX[1] = [] then \n YY[1]:=Id; \+ \n start:=2 \nend if;\nfor k from start to nops(XX) do\n ind:=XX[ k][1];\n if ind=10 then \n bas:=e||0 else bas:=e||ind \n e nd if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if in d=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:=convert(YY,list);\npr otect(op(YY)); #protect basis monomials\nreturn YY\nend proc:\n " }} {PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1s tr" }{TEXT -1 327 " finds all locations of the first string of length \+ one in the second string of length at least one. It returns a set of t hese positions. If the first string is not found then it returns \{0 \}. This procedure is primarily for internal use in 'type/clibasmon' a nd 'cliparse'. \nTypical use: find1str(e,e1we2we3); find1str(w,e1we2); " }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 663 "find1str :=proc(a1::symbol,a2::symbol) local ns,p,p1,ap,le2;\nglobal _prolevel; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`,remember;\ndescription `Last revised: Dec ember 20, 2007`;\n#############################################\nle2:= length(a2):\nif _prolevel=false then\nif length(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,a2):\nap:=\{p\}:p1:=p:\nwh ile 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 spelling of basis monomials. Wh en unable to decide if the given input is correct, it tells the user t o check spelling or define the given string as a Maple constant. If th e spelling is correct, it returns true; if it is not correct, it retur ns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1 ,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1180 "cliparse:=proc(a1::any thing) local x,S1,S2,p,S;\nglobal _prolevel,_scalartypes;\noptions `Co pyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: December 20, 2007`;\n#### #########################################\nif _prolevel then return tr ue end if;\nif type(a1,_scalartypes) then return true end if;\np:=remo ve(type,a1,_scalartypes):S1:=\{op(p)\}:\nfor x in S1 do \n if type( x,_scalartypes) or type(x,clibasmon) then S1:=S1 minus \{x\} end if;\n end do; \nS2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartype s) or type(x,clibasmon) then S2:=S2 minus \{x\} end if;\nend do;\nS:=r emove(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 m inus \{x\} end if;\nend do;\nif S=\{\} then return true end if;\nS1:=s elect(type,S,procedure):\nif S1 <> \{\} then\n error \"procedure nam e %1 that has been found in input is not allowed as a symbolic coeffic ient\",op(S1)\nend if;\nif nops(S)=1 then \n error \"check spelling \+ of %1 or define it as a constant or an alias\",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. Functi on " }{TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered \+ Clifford scalar with the scalar times the unit element 'Id'. It may al so be applied to matrices with Clifford algebra entries.\n\nTypical us e: displayid(e1+2*Pi);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "displa yid:=proc(a1::\{array,matrix,algebraic\}) local KK,p;\noptions `Copyri ght (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n######## #####################################\nKK:=proc() if type(args[1],clis calar) then return args[1]*Id \n elif hastype(args[1],clibas mon) then return args[1] \n end if \nend proc:\nif type(a1, \{array,matrix\}) then return map(procname,a1) end if;\np:=expand(a1): \nif type(p,\{`*`,cliscalar,clibasmon,climon\}) then return KK(p) \nel if type(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " } {TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis eleme nts in the given Clifford polynomial.\n\nNOTE: 'cliterms' also works w ith terms of type cliprod and it finds correctly terms involving such \+ expressions. \n\nTypical use: cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1020 "cliterms:= proc(a1::anything) local S1,S2,S3 ,x,p,Cliplusflag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: December 20, 2007`;\n############################################ #\nCliplusflag:=assigned(Cliplus):\nif hastype(a1,cliprod) and not Cli plusflag and _warnings_flag then \n WARNING(`argument to 'cliterms' \+ contains type cliprod. Load 'Cliplus' to extend functionality of CLIF FORD. Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,clipr od\}) then return \{a1\} end if;\np:=displayid(simplify(a1)):\nif hast ype(p,cliprod) then \n S1:=remove(type,\{op(p)\},cliscalar);\n S2: =select(hastype,S1,\{clibasmon,climon,cliprod\});\n S3:=\{\}:\n wh ile not S2=\{\} do\n S3:=S3 union select(type,S2,\{clibasmon,c liprod\});\n S2:=select(hastype,map(op,remove(type,S2,\{clibas mon,cliprod\})),\{clibasmon,cliprod\});\n end do;\nreturn S3\nend if ;\nx:='x':\nS1:=remove(type,\{op(p)\},cliscalar);\nreturn \{seq(select (hastype,x,clibasmon),x=S1)\}\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " }{TEXT 288 11 "clibilinear" }{TEXT -1 360 " \+ makes any procedure K specified as the third argument bilinear with re spect to Clifford scalars in the first two arguments. The first two ar guments are of the type clipolynom, i.e., Clifford polynomials. The th ird argument is a string or a procedure.\nIt can handle terms involvin g elements of type cliprod.\n\nTypical use: clibilinear(e1+2*e2we3,Id+ 2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 923 "clibilinear:=proc (a1,a2,a3::\{procedure,name,symbol,matrix,array\}) \n loca l tail,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1,co2;\noptions `Copyright \+ (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: December 20, 2007`;\n############ #################################\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1):\np2:=clicollect(a2):\n t ail:=args[4..-1];\n if type(p1,\{climon,cliprod\}) 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 li st will be huge for long polynomials\n res:=0:\n for x in S12 do \n \+ cli1:=select(type,x[1],\{cliprod,clibasmon\}):\n cli2:=select(ty pe,x[2],\{cliprod,clibasmon\}):\n co1:=coeff(x[1],cli1):\n co2:= coeff(x[2],cli2):\n res:=res+co1*co2*a3(cli1,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 procedu re K specified as the second argument linear with respect to Clifford \+ scalars (elements of type cliscalar). It can now distribute over Cliff ord polynomials with elements of `type/cliprod`. Any additional parame ters are passed on to the procedure entered as the second argument.\nT ypical use: clilinear(a*e1+2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "clilinear:=proc(a1::\{symbol,cliscalar,clibasmon,cli mon,clipolynom\},a2::\{name,procedure\}) \nlocal tail,p1,S1,res,x,cli1 ,co1;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\ntail:=arg s[3..-1];\nif type(a1,cliscalar) then return a1*a2(Id,tail) end if;\np 1:=displayid(a1):\nif type(p1,climon) then S1:=[p1] else S1:=[op(p1)] \+ end if:\nres:=0:\nfor x in S1 do\n cli1:=select(hastype,x,\{clibasm on,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 "N o. 10. Procedure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the gi ven multivariate Clifford polynomial with respect to the Clifford inde tereminates found in the expression via the procedure 'cliterms'. It p uts scalar coefficients of the type cliscalar 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 440 "clisort:=proc(p::algebraic) local L,N;\n options `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: December 20, 2 007`;\n#############################################\nif type(p,matrix ) then return map(procname,p) end if;\nif type(eval(p),\{climon,clipol ynom\}) or hastype(eval(p),cliprod) then\n L:=cliterms(expand(displa yid(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 "cli collect" }{TEXT -1 382 " reorders monomial terms in standard order and then collects them in a multivariate Clifford polynomial. It may also be applied to matrices with entries in a Clifford algebra. It will si mplify 6 + 7*Id to 13*Id. It collects now terms of type cliprod, if p resent.\n\nNOTE: 'clicollect' also works with terms of type cliprod an d it collects correctly terms involving such expressions. " }}{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 497 "clicollect:=proc(a1::algebraic) local p,L; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2007`;\n########### ##################################\nif type(a1,matrix) then return map (procname,a1) end if;\np:=expand(a1):\nif type(p,cliscalar) then retur n p*Id\nelif type(p,clipolynom) then \n L:=cliterms(p);\n retu rn map(simplify,collect(displayid(p),L,'distributed'))\nelse return ar gs[1] \nend if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. \+ The procedure " }{TEXT 292 3 "ord" }{TEXT -1 319 " returns an ordered list of positions in a monomial, e.g., e1we2, where vector indices \+ are found. Then, nops(ord(e1we2)) can be used to find the order of th e monomial. Note that for consistency we have ord(Id) = ord(numeric) \+ = ord(numeric*Id) = ord(cliscalar)=[] where cliscalar is 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 387 "ord:=proc(a1) local v,k;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2007`;\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 "N o. 13. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes o ne symbol 'ei' from the location specified by the procedure 'ord'. \n( NOTE: procedure 'ord' specifies location of the index 'i' in 'ei'.) T his procedure is primarily for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 579 "cliremove:=proc(p::posin t,s::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 199 5-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ,remember;\ndescription `Last revised: December 20, 2007`;\n########## ###################################\nif not _prolevel then\n if s=Id then error \"second argument must be Grassmann basis monomial of rank >= 1\" end if;\nend if;\nS2:=substring(s,(p+2)..length(s));\nS1:=subs tring(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n el if S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure " } {TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomial ( or a constant times a monomial) and it returns them as a list of strin gs. If necessary, they can be returned as a list of integers if optio n 'integers' is selected (in fact, any name which evaluates to a strin g may be used as the option). Indices could be now integers, letters, or they could be mixed. Note that extract(Id) = [] and extract(numeri c) = extract(numeric*Id) = [] results in no vector indices. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typic al use: extract(2*e1we2); or extract(e2we3, \"integers\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 732 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 20, 20 07`;\n#############################################\nif type(a1,clisca lar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n t ype(a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nelse \+ \n error \"wrong argument: %1\",a1 \nend if;\nif v = Id then return \+ [] end if;\ninds:=map(convert,remove(member,StringTools:-Explode(v),\{ \"e\",\"w\"\}),symbol);\nif nargs=1 then return inds \n elif type(a2 ,symbol) then \n return map(parse,inds)\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 1076 "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-2008 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2007`;\n###################################### #######\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) e nd 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, 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))];\nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[s s];\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 "m axindex" }{TEXT -1 226 " which finds the greatest index in the given C lifford polynomial or in the given list or set of Clifford monomials. \+ It returns 0 for a Clifford scalar (an element of type cliscalar).\n\n Typical use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 813 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: December 20, 2007`;\n############### ##############################\nif type(a1,cliscalar) or a1=Id then re turn 0 elif\n type(a1,list) then return max(op(convert(map(procname, a1),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, mons,'integers'));\n symbinds:=remove(type,inds,integer);\n if sym binds = \{\} 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: max grade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 400 "max grade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\no ptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 07`;\n#############################################\nif type(eval(a1), cliscalar) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nretu rn 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 " defines a left contraction between any multivector u an d a multivector v, i.e., multivector u acts on the multivector v from \+ the left. This procedure is now bilinear in both arguments. It can a ccept third argument 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 2317 "LC:=proc(x1::\{c liscalar,clibasmon,climon,clipolynom\},\n y1::\{cliscalar,clib asmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lnam e,res,coB,nameB,x,y;\n global _CLIENV,B;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\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,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in LC. See ?LC for more help.\" \n end if;\nelse\n error \+ \"two or three arguments expected in LC. See ?LC for more help.\"\n en d if;\n################################\nx,y:=expand(x1),expand(y1): # #NEW\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n \+ lst1:=Clifford:-extract(x,'integers');\n lst2:=Clifford:-extrac t(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 makeclibasmon([op(su bs(lst2[j]=NULL,lst2))]),j=1..N2));\n return reorder(res) \n \+ else\n res:=\nprocname(makeclibasmon(lst1[1..-2]),procname(ma keclibasmon([lst1[-1]]),y,lname),lname);\n return reorder(res) \n end if;\n elif type(y,climon) then\n term,cf:=select remove(type,y,clibasmon);\n return expand(cf*procname(x,term,l name))\n elif type(y,clipolynom) then\n return add(procna me(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) then \n \+ return displayid(scalarpart(x)*y)\n end if; \n elif type(x,clim on) then\n term,cf:=selectremove(type,x,clibasmon);\n return exp and(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n re turn add(procname(i,y,lname),i=[op(x)])\n elif type(x,cliscalar) then \n return x*reorder(y)\n end if;\nerror \"Got input %1 and %2 bu t 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 gives left cont raction in the orthogonal Clifford algebra Cl(Q) of the quadratic 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 numeric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Grenob le, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLCQ(e 1 + 2*e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1795 "LCQ:=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-200 8 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2007`;\n######################## #####################\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \+ \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symb ol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n \+ lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,ma trix,array\})) then\n coB:=op(select(type,\{op(args[3])\},numeri c));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third argumen t in LCQ. See ?LCQ for more help.\" \n end if;\nelse\n error \"tw o or three arguments expected in LCQ. See ?LCQ for more help.\"\nend i f;\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 <> \{\} then \n ret urn LC(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:=li nalg[coldim](evalm(lname)):\n if m>N then \n error \"input cont ains index larger than size of bilinear form %1\",lname \n end if;\n end if:\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(l name[ii,ii],ii=1..m);\n return LC(x,y,linalg[diag](L))\nelif \n ty pe(lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op( select(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},\{name,symbol,array,matrix\}));\n L:=seq(coB*nameB[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 any multivector u \+ and a multivector v, i.e., multivector u acts on the multivector v fro m the right. This procedure is now bilinear in both arguments. It ca n 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*e 2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2280 "RC:=pr oc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clisca lar,clibasmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,ter m,lname,res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\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,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in RC. See ?RC for more help.\" \n end if;\nelse\n error \+ \"two or three arguments expected in RC. See ?RC for more help.\"\nend if;\n################################\n if type(x,clibasmon) then\n \+ if type(y,clibasmon) then\n lst1:=Clifford:-extract(x,'integer s');\n lst2:=Clifford:-extract(y,'integers');\n N1:=nops(lst 1);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 res:=`+`(seq(co B*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(proc name(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:=selectre move(type,y,clibasmon);\n return expand(cf*procname(x,term,lname) )\n elif type(y,clipolynom) then\n return add(procname(x,i,lna me),i=[op(y)])\n elif type(y,cliscalar) then return reorder(x)*y \n end if;\n elif type(x,climon) then\n term,cf:=selectremove(ty pe,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,cliscalar) then \n return displayid(x*scalarpart(y ))\n end if;\nerror \"Got input %1 and %2 but can only process const ants 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 argument such as K \+ or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1800 "RCQ:=p roc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clis calar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m,Sxy,symbxy, lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2008 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2007`;\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 RCQ. \+ See ?RCQ for more help.\" \n end if;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ for more help.\"\nend if;\n###### ##########################\nSxy:=remove(type,map(op,\{op(x),op(y)\}),c liscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbx y:=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 h ave maxindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldi m](evalm(lname)):\n if m>N then \n error \"input contains i ndex 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[i i,ii],ii=1..m);\n return RC(x,y,linalg[diag](L))\nelif \n type(lna me,`&*`(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 algebra,i.e., i t reverses signs of odd elements and leaves signs of even elements unc hanged." }}{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 553 "gradeinv:=proc(a1::\{matrix,cliscalar,clibas mon,climon,clipolynom\}) global _CLIENV;\noptions `Copyright (c) 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\nif type(a1,matrix) then return map(procname ,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR]: =-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFACT OR])^maxgrade(a1)*a1 \n else return clilinear(a1, procname) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 23. Define the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " product of any number of Clifford polynomials. The infix form of this associative m ultiplication 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 exterior alge bra.\n\nNew feature: When the dimension of the vector space is known, \+ either from the size of the matrix B or from the global parameter dim_ V that can be set by the user, the output of the procedure does not in clude terms of grade higher than the dimension of the vector space in \+ case symbolic indices are used. \n\nThe default value of this global v ariable is 9 and it it set by the initialization file when Clifford is loaded.\n\nWhen the procedure is invoked, it checks whether the bilin ear form B has been defined. If yes, the procedure checks whether the \+ size of B is less than the current value of dim_V. If again yes, a war ning message is issued by the procedure and the value of dim_V is redu ced. If the size of B is larger than the current value of dim_V, no wa rning message is issued and the value of dim_V is increased to linalg [coldim](B).\n\nThe warning message can be supressed by addign 'false' to a global parameter _warnings_flag whose default value is set to tr ue 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 3062 "wedge:=proc(a1::\{cliscalar,cliba smon,climon,clipolynom\},\n a2::\{cliscalar,clibasmon,climo n,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12,maxindexfl ag,expr,maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: December 20, 2007`;\n############### ##############################\nkk:='kk':\nif member(0,[args]) then re turn 0 \nelif \n remove(type,\{args\},cliscalar)=\{\} then return pr oduct(args[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then\n if li nalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < dim_V then \n dim_V:=linalg[coldim](B);\n if _warnings_flag then \nprintf(\"Warning, since B has been (re-)assigned, value of dim_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 pos itive integer between 1 and 9, inclusive, but current value of dim_V i s %1\",dim_V\nend if;\n################\ni12:=\{\}:\nfor ii from 1 to \+ nargs do\n pi:=args[ii]: \n i12:=i12 union map(op,map(Clifford:- extract,cliterms(pi),'integers')):\nend do;\nn12:= select(member,i12, \{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{\} then\n maxin:=max(op(n12)); \n maxindexflag:=evalb(maxin > dim_V);\nelse maxindexflag:=false:\n end if:\nif maxindexflag then \n error \"argument(s) contain(s) inde x larger then current value of dim_V which is now %1. To complete comp utation, increase value of dim_V or assign square matrix of size at le ast %2 by %3 to bilinear form B\",dim_V,maxin,maxin\nend if;\n######## ########\nwedge2:=proc() local expr,i1,i2,n1,n2,i12,s12,symbindexflag; global dim_V;\n i1:=\{op(Clifford:-extract(args[1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(args[2]))\};n2:=nops(i2):\n if args[1]=Id \+ then \n if n2>dim_V then return 0 else return args[2] end if;\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 <> \{\} th en 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]));\ne nd 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 hast ype(expr,trig) then \n return clicollect(map(combi ne,clicollect(expr),trig))\n else \n \+ return reorder(expr)\n end if;\nelse expr:=procna me(procname(a1,a2),args[3..nargs]):\n if hastype(expr,trig) then \+ \n return clicollect(map(combine,clicollect(expr),trig))\n \+ else \n return reorder(expr)\n end if;\nend if;\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampersand version of " } {TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford:-setu p)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " computes sign of a permutation that sort s a list of indices.\n\nTypical use: permsign([1,3,2]); permsign([j,1, i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 881 "permsign:=proc(L::li st) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `Copyr ight (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: December 20, 2007`;\n####### ######################################\nL1:=L:\nN:=nops(L1):\nif N=1 t hen return 1 end if:\n################## new\nn12,s12:=selectremove(me mber,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################## new \nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss];\nen d 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;\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 2254 "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-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n description `Last \+ revised: December 20, 2007`;\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(cl ibilinear(a12[1],a12[2],procname,lname))\nend if: \n################## ####################################################################\n ### old name cmul2B: this procedure computes recursively Clifford prod uct of any two #\n### cliscalars, clibasmons, climons, and clipolynoms in Clifford algebras Cl(lname) #\n################################## ####################################################\n if nargs<>3 th en error \"exactly three arguments are needed\" end if:\n if has(0,ma p(simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` then return a 1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-extract (a1,'integers');\n N:=nops(L):\n ################\n ##### The follo wing will allow for lname to be -B, for example:\n if type(lname,\{na me,symbol,array,matrix\}) then\n coB,nameB:=1,lname:\n elif type( lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(s elect(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(l name)\},name));\n else\n error \"third argument is of unexpected \+ type\"\n end if;\n ################\n if N=0 then return coeff(a1,I d)*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..no ps(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:=substring(a 1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1,p2,pro cname,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, a2,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 4903 "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-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007` ;\n#############################################\n###This is additiona l 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],pro cname,lname))\nend if: \n############################################# #############################################\n### This procedure comp utes Clifford product of any two cliscalars, clibasmons, climons, #\n# ## and clipolynoms in Clifford algebras Cl(lname) using Rota-Sten clif fordization #\n### Procedure cmulRS modified by Rafal to accept \+ -K, or -B for lname. #\n########################### ###############################################################\n if \+ nargs<>3 then error \"exactly three arguments are needed\" end if:\n \+ if has(0,map(simplify,[a1,a2])) then return 0 end if;\n if a1 = `Id` \+ then 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 \+ example:\n if type(lname,\{name,symbol,array,matrix\}) then\n coB ,nameB:=1,lname:\n elif type(lname,`&*`(numeric,\{name,symbol,array,m atrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n error \"th ird argument is of unexpected type\"\n end if;\n ################\n \+ L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Cliffor d:-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \n retu rn 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(makeclibasmo n([op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*makecli basmon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; gener ate 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 :=proc(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:= genPS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:=sort(pL ist2,(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 r ota-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[lst 1[1],lst2[1]] end if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],lst2[i]]* cup(lst1[1..-2],subs(lst2[i]=NULL,lst2),coB,nameB)\n \+ ,i=1..nops(lst2))\n end p roc:\n################################################################ ################### \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms whic h are potentially non zero in the cup(..) tangle #\n################## #################################################################\n m ax_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 r es:=res+\n pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup(map(fun1 ,pList1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n ma keclibasmon([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 cmul RS 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 558 "cmulgen:=proc() global _default_Cl ifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2008 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: December 20, 2007`;\n############################### ##############\nif _default_Clifford_product <> 'cmulgen' then\n ret urn _default_Clifford_product(args)\nelse \n if _warnings_flag then \n WARNING(\"to assign Clifford product, execute 'useproduct' with a rgument 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 1379 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2008 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2007`;\n#################################### #########\n if type(op(procname),procedure) then\n lname:=`B`;\n \+ else\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### _def ault_Clifford_product is used in the following. # ################### #######################################\n return clicollect(clibiline ar(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 \+ makes no difference whether cmulgen or #\n### _default_Clifford_produc t is used in the following. # ####################################### ###################\nif not type(_default_Clifford_product,procedure) \+ then \n error \"global variable _default_Clifford_product must be as signed a procedure so that 'cmul' could proceed beyond this point. Sor ry. For help see ?cmul.\" \nend if;\n return procname(clibilinear( eval(args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of " }{TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctl y 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, e2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 2305 "`&m`:=proc() local NP,ARGS,coB,nameB,lname ,decindex,flagdec;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: December 20, 2007`;\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 flag dec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args]; \n if type(lname,`&*`(numeric,name)) then\n coB:=op(select (type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},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 t ype([args],listlist) then\n if type(op(args),function) then\n A RGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args))); \n if type(nameB,`&*`(numeric,name)) then\n coB:=op(selec t(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(n ameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,fu nction)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(ty pe,nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \+ \"unable 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],lis t) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nel se\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) \+ then return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn \+ cmul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to select which procedure is used to compute Cliffor d product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1258 "u seproduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_C lifford_product; #,cmulgen;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: December 20, 2007`;\n################################## ###########\n######################################################### ##########\n###This procedure uses global variable _default_Clifford_p roduct #\n########################################################### ######## \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defin ed\}) then \n WARNING(\"expecting one of the following Clifford pro ducts: cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\nif member(name,\{cmul_user_defined\}) and not type(name,procedure) then \n WARNING(\"no computations with cmul can be peformed yet since cmu l_user_defined has not been defined as procedure. Select cmulRS, cmulN UM, or a new procedure as argument to useproduct.\");\n _default_Cli fford_product:=name;\nreturn NULL;\nend if;\n######################### #######\n_default_Clifford_product:=name; #change value of _default_Cl ifford_product \n################################\nwstr:=cat(\"cmul wi ll 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 'cmu l' and '&c'. It gives the Clifford multiplication in the Clifford alg ebra 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 procedure 'rmulm' described below in (32), this multiplication can al so be applied to matrices with entries in a Clifford algebra.\n\nThis \+ procedure can now accept an optional index which could be K or -K. " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Prop osed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Tha nks!" }}{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 1424 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2008 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n####################################### ######\n####################################\nif type(op(procname),pro cedure) 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 376 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\na1:=simplify(a ):\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1):\n return coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes t he k-vector part of the given Clifford polynomial u where k is a nonne gative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. W hen 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 597 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\na1:=expand(simplify(a)): #expand is needed \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,`+`) th en p:=select(K,a1) elif\n maxgrade(a1)<>a2 then p:=NULL else \n p: =a1 \nend if;\nif p=NULL then 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 " computes Clifford exponential of a Clifford n umber in Cl(B) up to the order specified by the second argument which is a nonnegative integer n. It n = 0 then this procedure returns 'Id' . It can accept another argument such as B or -B. " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 185 "Typical use: cexp(e1 we2*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 1360 "cexp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::no nnegint) \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyrig ht (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2007`;\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:=a rgs[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{ name,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(arg s[3])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numer ic));\n lname:=args[3]:\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nels e\n error \"two or three arguments expected in cexp. See ?cexp for m ore help.\"\nend if;\n################################\nk:='k':\nif ty pe(p,\{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\n if 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 elif N=1 then return Id+pp; \n else \n an s1:=cexp(pp,N-1,lname);\n ans2:=cexp(pp,N-2,lname);\n ans: =ans1+cmul[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nen d 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 in Cl(Q) up to the order specified by the second argument which is a nonnegative integer n. It n = 0 then this procedu re 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 "Typical use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2 )*t, 4);\n cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e 1we2)*t, 4,K);\n cexpQ(Id+2*e1we3,4); or cexpQ(e1 \+ + 2*e1we2, 4,-K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1374 "cexpQ:=pro c(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \+ \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\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,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n e rror \"two or three arguments expected in cexpQ. See ?cexpQ for more h elp.\"\nend if;\n################################\nk:='k':\nif type(p, \{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\nif ev alb(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 ret urn Id \n elif N=1 then return Id+pp; \n else \n ans1:=c expQ(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. Proce dure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponenti al of a Clifford number u up to the order specified by the second arg ument which is a nonnegative integer n. It returns 'Id' when n = 0. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "T ypical use: wexp(e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 611 "wexp:= proc(p::\{cliscalar,clibasmon,climon,clipolynom\},N::n onnegative) \nlocal pp,power,cu,i;\noptions `Copyright (c) 1995-2008 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: December 20, 2007`;\n########################### ##################\n if nargs<>2 then error \"two parameters are need ed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then return 1 elif \n N=1 then return 1+clisort(pp) end if;\n power:=pp;\n cu:=1+pp ;\n for i from 2 to N do\n power:=wedge(power,pp);\n cu:=cu + power/i!;\n end do;\n return subs(Id=1,clicollect(clisort(cu)));\n \+ end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " } {TEXT 329 9 "reversion" }{TEXT -1 411 " calculates reversion in the Cl ifford algebra. It is linear in its argument and it is always a Cliffo rd algebra anti-automorphism. 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 gradat ion of the exterior algebra. This procedure can now take a third opti onal 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 2640 "reversion:=pro c(a1::\{cliscalar,clibasmon,climon,clipolynom,matrix\}) \n l ocal ind,expr,wtp,ptw,lname,flagindexed;\n global _scalartyp es,B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\nif hastyp e([args[1]],cliprod) then \n error \"in order to handle 'type/clipro d', load in package Cliplus\" \n end if;\n############################ \nif type(a1,cliscalar) then return a1 end if;\n###################### ######\nif nargs=1 then\n lname:=`B`;\n flagindexed:=false:\neli f nargs=2 and type(args[2],\{symbol,name,array,matrix,`&*`(algebraic,n ame)\}) then\n lname:=args[2];\n flagindexed:=true:\nelse error \+ \"only one or two arguments are expected\"\nend if;\n################# ###########\n### Auxiliary function that converts wedges to Clifford p roducts: wedge ->> Clifford product\n############################\nwtp :=proc(a1,lname) local ind,i,arg,rdmon,eq1,ans; global _scalartypes; \+ \nif type(a1,\{`+`,`*`\}) then return (map(wtp,a1,lname)) \n elif t ype(a1,_scalartypes) then return a1\n elif type(a1,symbol) and Searc hText(w,a1)=0 then return a1\n elif type(a1,symbol) and not member(l ength(a1),\{5,8,11,14,17,20,23,26\}) \n then return a1 \nend if ;\nrdmon:=reorder(a1):\nind:=Clifford:-extract(a1,'integers'):\ni:='i' :\narg:=[seq(cat(e,op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(arg))=si mplify(eval(cmul[lname](op(arg))));\nif a1=rdmon then ans:=simplify(so lve(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 funct ion that converts Clifford products to wedge: Clifford products ->> we dge\n############################\nptw:=proc(a1,lname) local i,arg,rev arg; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then return (map(p tw,a1,lname)) \n elif type(a1,_scalartypes) then return a1 \n elif type(a1,symbol) and SearchText(e,a1)=0 then return a1 \n elif type( a1,symbol) and length(a1)=2 then return a1 \n elif type(a1,symbol) a nd not member(length(a1),\{2,4,6,8,10,12,14,16,18\})\n then ret urn a1 \n end if;\ni:='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(displa yid(expr)):\nreturn clisort(expr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40. Procedure " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates conjugation in the Clifford algebra. It is linear \+ in its argument. Note that 'conjugation' is defined as a composition \+ of 'reversion' and 'gradeinv'. Hence, it does not preserve the multiv ector gradation when the antisymmetric part of B is non-zero. It can \+ now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjugatio n(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 824 "conjugation:=proc(a1::algebraic) local lname;globa l B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\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];\nelse error \"only one or two arguments are expect ed\"\nend if;\n###########################\nif type(a1,matrix) then re turn map(procname,a1,lname) elif\n type(a1,cliscalar) then return a1 elif\n type(a1,\{clibasmon,climon,clipolynom\}) then\n retur n eval(gradeinv(reversion(a1,lname)))\nelse \n error \"wrong input t ype: input must be of type cliscalar, clibasmon, climon, clipolynom, o r 'matrix'\" \nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c_con jug" }{TEXT -1 72 " calculates complex conjugate in a complexified Cli fford algebra; thus, " }}{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` is the imaginary unit, i.e., I = sqrt(-1). This proce dure 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 698 "c_conjug:=proc(a1 ::algebraic) local ba,co,terms,t,i;\noptions `Copyright (c) 1995-2008 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: December 20, 2007`;\n########################## ###################\nif type(a1,matrix) then return map(procname,a1) e lif\n type(a1,cliscalar) then return conjugate(a1) elif\n type(a1, \{clibasmon,climon,clipolynom\}) then\n t:='t':\n ba:=cl iterms(a1);\n co:=[coeffs(a1,ba,'t')];\n terms:=[t];i:=' i':\n return clisort(add(conjugate(co[i])*terms[i],i=1..nops(co )))\n else \nerror \"wrong input type: input must be of type cliscal ar, clibasmon, climon, 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 th e Clifford algebra Cl(B) in the left- or right-regular representation, or under Lie or automorphism action with respect to an ordered basis \+ specified by the user. The element p is entered as the first argument and the basis in the form of a list is specified as the second argume nt, e.g., buildm(u, basis). It is also possible to specify options 'l eft', 'right', 'Lie', 'auto', 'false, and 'true'. For example, one can find the left-regular representation of the algebra on itself or, whe n Cl(B) is simple and isomorphic to a ring of real matrices, one can f ind matrices representing Clifford polynomials in a real basis of a mi nimal ideal. However, there are new procedures below specifically des igned for finding spinor 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\nbuild m(e1, [Id, e1, e2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'right'); \+ buildm(e1, [Id, e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2 ],'false'); buildm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm(e1, \+ [Id, e1, e2, e1we2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2968 "buildm:=proc(a1::\{cliscalar,clibasmon,climon,clipo lynom\},\n a2::list(\{cliscalar,clibasmon,climon,clipolyno m\}))\nlocal A,L,N,a11,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,f lag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\nflag:=true :\nif nargs=2 then a33:='left' end if;\nif nargs=3 then \n if member (args[3],\{'true','false'\}) 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 n args=4 then\n if member(args[3],\{'left','right','Lie','auto'\}) and member(args[4],\{'false','true'\}) then\n a33:=args[3]; \+ \n flag:=args[4];\n else \n error \"third optional argumen t must be 'left', 'right', 'Lie', 'auto', and the fourth optional argu ment must be 'false' or 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many arguments. See ?buildm for more help.\" end if;\n### ##############################################\nif flag then \nA:=lina lg[genmatrix](args[2],cbasis(maxindex(args[2])));\nif linalg[rank](A) \+ < nops(args[2]) then \n error \"elements of the list %1 are linearly dependent. Apply 'findbasis' to this list first.\",a2 \nend if;\nend \+ if;\n###local procedure\nnontrivial:=proc(S::\{set(\{relation,algebrai c\}),list(\{relation,algebraic\})\}) \nlocal istrivial;\nprintlevel:=2 :\nistrivial:=proc(x) if type(x,relation) then evalb(x) else evalb(x=0 ) end if end;\nremove(istrivial,S)\nend proc:\n### \nL:=a2:N:=nops(L): xm:=array(1..N,1..N):\nif a33='left' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1. .N))) \n end do;\nelif a33='right' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(L[i],a1)-add(x m[j,i]*L[j],j=1..N)))\n end do;\nelif a33='Lie' then\n for i fr om 1 to N do\n eq||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(expand(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(Lba sis) 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:=n ontrivial(sys): #eliminate trivial equations\nsol:=solve(sys,vars);\ni f sol=NULL then \n error \"no matrix represents %1 in the basis %2 u nder 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 "findbasis" }{TEXT -1 680 " finds a basis in a linear v ector space spanned by a set of Clifford polynomials entered as a list . The procedure is used, for example, when finding a basis for a spi nor space S considered as a minimal left or right ideal in Cl(B) gener ated by a primitive idempotent f. To speed up computations, it is advi sable to a standard Clifford basis for Cl(B) in the form of a list of \+ basis monomials as the second argument. If only one list is specified , 'findbasis' determines a suitable Clifford basis itself but it takes twice as much time then since it creates a Clifford basis by using 'c basis(maxindex)' where '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 1478 "findbasis:=proc(a1,a2) local L,clibasis,M ,i,m,r,v,S; \nglobal _prolevel;\noptions `Copyright (c) 1995-2008 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: December 20, 2007`;\n############################## ###############\nif evalb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{clibasmon,climon,clipolynom\})) or \n \+ type(a1,set(\{clibasmon,climon,clipolynom\}))) then\nerror \"ar gument of type list/set(\{clibasmon,climon, or clipolynom\}) was expec ted\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,clim on,clipolynom\})) or \n type(a1, set(\{clibasmon,climon,cli polynom\}))) and \n (type(a2,list(clibasmon)) or type(a2,set (clibasmon)))) or nargs>2 then\nerror \"arguments of type list/set(\{c libasmon,climon,clipolynom\}) and list/set(clibasmon) were expected\" \+ \nend if;\nend if;\nif nops(a1)=1 then return a1 end if;\n#L:=sort(map (displayid,convert(a1,list)),bygrade):\nL:=map(displayid,convert(a1,li st)): ####NO SORT\nif nargs=2 then clibasis:=sort(convert(a2,list),byg rade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),li st),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[r ank](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 t hen 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 for 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 o f 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 sort a list L by grade one may use sort(L, bygrade) where 'bygr ade' is a new procedure in this package described below. The output f rom the procedure 'cbasis' is already sorted that way." }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argu ment 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 stored under clidata()[5] to generate the real basis and it returns the stored list clidata()[5] as the second list in its ouput. If f does not equal clidata()[4] then complete computations are performed but they may take longer. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 129 "It is assumed that the numerical value s of B have been specified.\n\nThe procedure returns a list consisting of two ordered lists: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 91 "(1) the first list contains the real basis o f S written as expanded Clifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 106 "(2) the second list co ntains basis monomials from the standard basis in Cl(B) which generate the " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by m ultiplying f on 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 o rdered lists.\n\nTypical use: minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2 we3,e1we2we3],(1/2)*(Id+e3),'left');\n minimali deal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'right'); \n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2247 "minimali deal:=proc(a1,a2,a3) \nlocal L,gens,m,flag1,f,flag_left,data,SB,g,SBge ns,pq,p,q,l,ni,realdim,dimoverK,cb,N,bel; \nglobal B,_shortcut_in_mini malideal,_prolevel;\noptions `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2007`;\n########################################## ###\nif not type(B,diagmatrix) then \n error \"bilinear form B has n ot been assigned a matrix or is not diagonal\" \nend if; \nif not _pro level then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) t hen\n error \"first argument must of type list(\{clibasmon,cl imon,clipolynom\})\" \n elif not type(a2,'primitiveidemp') then \+ \n error \"second argument must be a primitive idempoten t\" \n elif not member(a3,\{'left','right',\"left\",\"right \"\}) then\n error \"third argument must be 'left', or 'right'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\nif member (a3,\{'left',\"left\"\}) then flag_left:=true else flag_left:=false en d if;\ng:='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimalideal the n\n m:=maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 th en\n data:=clidata():\n if eval(eval(data[4]))=eval(f) or ev al(eval(data[4]))=gradeinv(f) then\n SBgens:=data[5]:\n \+ if flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n \+ return [SB,SBgens,a3];\n end if;\n end if;\nend if; \n#I f can't use the shortcut, perform necessary computations.\npq:=Bsignat ure():\np:=pq[1]:q:=pq[2]:\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member( (p-q) mod 8,\{0,1,2\}) then \n realdim:=2*ni; \n dimoverK:=2 *ni; \nelif member((p-q) mod 8,\{3,7\}) then \n realdim:=4*ni; \n dimoverK:=2*ni; \nelse\n realdim:=4*ni; \n dimoverK:=n i \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]:cb:=remove(member,L,[Id]); \nfor g in cb while nops(SB) < reald im do\n N:=nops(SB):\n if flag_left then bel:=cmulQ(g,f) else be l:=cmulQ(f,g) end if; \n SB:=findbasis([op(SB),bel]); \n if nop s(SB)>N then SBgens:=[op(SBgens),g] end if;\nend do:\nreturn [SB,SBgen s,a3];\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedu re " }{TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis for a fiel d K. The field K is the field of the spinor space S = Cl(B)f or S = f Cl(B) of the given Clifford algebra Cl(B). It is isomorphic to the r eals, 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 defined, the first argument of the procedure is expected to be th e same as the output from the procedure 'minimalideal'. The second ar gument is the idempotent f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 225 "The procedure eliminates from the list of basis elements in the real ideal space nilpotent elements and leav es only those whose square modulo f is either +1 or -1. It returns th ose elements as the first list in its output. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 200 "If the primitive idemp otent f is the same as the one stored under clidata()[4] and if the g enerators of the real basis in the minimal ideal S match those stored \+ under clidata()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses generators of K stored under clidata()[6] and returns them a s 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 c ontains generators (Clifford basis monomials) of the elements in the f irst list. Elements of the two lists are in one-to-one relationship. \+ " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[d iag](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 4633 "Kfield:=proc(a1::list(\{list,string,symbol\}),a2::clipolynom) \n local SB,gens,f,ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,di men,Kbasis,Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_proleve l;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\n#### Local p rocedure needed only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f ,mi,clibas,clibas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:= max(op(map(maxindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\nif type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n \+ clibas:=remove(member,clibas,gens):\n clib as:=[op(gens),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \+ \n if evalb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \+ \nend do:\nfor x in clibas2 do \nfor y in remove(member,clibas2,[x]) d o\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),\{Kbasi s[3],-Kbasis[3]\}) then\n if member(cmul(z,f),\{Kbasis[4],- Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') th en return [x,y,z]\n end if;\n end if;\n end if;\n end if;\nend do; \nend do;\nend do;\nend proc:\n####################################### #######\nif not _prolevel then\n if not type(a2,'primitiveidemp') th en \n error \"second argument must be a primitive idempotent\"\n \+ end if;\nend if;\n##############################################\nSB :=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n########## ####################################\nif not member(f,SB) then \n er ror \"idempotent entered %1 is not a member of the first list\",f \nen d if;\n###new line here instead of >>>not assigned(B)<<<\nif not type( B,matrix) then \n error \"matrix must be assigned to B\" \nend if;\n if side='right' then flag3:=true else flag3:=false end if;\ndata:=clid ata():\nfield:=data[1]:\nif field = 'real' then return [[f],[Id]] \nel if 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(Kge ns))]\n else Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nops(Kgens)) ] \nend if;\nreturn ([Kbasis,Kgens]) \nend if;\nend if;\n############# ####################################################\n#Do this when sh ortcut can't be used when field = 'complex'\n######################### ########################################\nKdim:=2:\nKbasis:=[f]:Kgens: =[Id]:\nn:=nops(gens):\nfor i from 1 to n while nops(Kbasis) < Kdim do \n if cmul(gens[i],gens[i])=-Id then\n expr:=cmul(f,gens[ i],f);\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];\n######################### ######################################\nelif field = 'quaternionic' th en \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:=[op( SB)];\n Kgens:=[op(gens)];\n r eturn [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) then\n if _shortcut_in_Kfield then\n f_from_data:=eval (eval(data[4])):\n fg:=gradeinv(f): \n if m ember(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif flag 3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..n ops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\nend \+ if;\n################################################################ \n#Do this when shortcut can't be used and field = 'quaternionic'\n### #############################################################\nKdim:=4 :\nKbasis:=[f]:Kgens:=[Id]:\nn:=nops(gens):\nfor i from 1 to n while n ops(Kbasis) < Kdim do\n if cmul(gens[i],gens[i])=-Id then\n \+ expr:=cmul(f,gens[i],f);\n if expr<>0 then Kbasis:=[op(Kba sis),SB[i]];\n Kgens:=[op(Kgens),gens[i]] \+ \n end if;\n end if:\nend do;\n########################### #\n ijk:=T4(Kbasis);\n############################\n Kgens:=[I d,op(ijk)]:\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,K gens]\nelse error \"wrong name of the field. See ?Kfield for more help .\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. \+ Procedure " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spino r 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 whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectivel y (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 ordere d 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 rig ht). These generators are found by the procedure 'minimalideal' and a re returned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the primiti ve idempotent 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 fi eld K; these generators are returned as a second list by the procedure 'Kfield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The fourth argument is either 'left' or 'right' dependin g whether we deal with the left minimal ideal Cl(B)f or the right mini mal ideal Cl(B)f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 434 "If the first three arguments in the input match respe ctively clidata()[5], clidata()[4], and clidata()[6] in that order, \+ i.e., SBgens=clidata()[5], f=clidata()[4], and FBgens=clidata()[6], \+ then the procedure finds previously computed generators of S over K wh ich are stored as clidata()[7]. These generators are then used to com pute the K-basis for S=Cl(B)f or S=fCl(B) depending whether the fourth argument 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 2865 "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-2008 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2007`;\n################################### ##########\nif not type(B,matrix) then \n error \"matrix must be ass igned to B\" \nend if;\nif not _prolevel then\n if not type(a2,'idem potent') then \n error \"second argument must be an idempotent\" \+ elif\n not member(a4,\{'left','right',\"left\",\"right\"\}) then \n \+ error \"the fourth argument must be 'left', or 'right'\"\n end \+ if;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens the n return [[f],[Id],a4] end if;\nif a4='left' or a4=\"left\" then flag_ left:=true else flag_left:=false end if;\ndata:=clidata():\nif _shortc ut_in_spinorKbasis then\n if eval(f)=eval(data[4]) and SBgens=dat a[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=SBKg ens)]\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)]) \nend if;\nposs:=remove(member,poss,FBgens);\nfor g in poss while nops (SB)>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 \+ SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n SBKgens:=[o p(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 [ SBKbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No . 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes \+ the 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 idempote nt f entered as the second argument. The procedure doesn't check whe ther f is primitive or not. Thus, the procedure returns 1 or -1 depen ding 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 "\nTh is procedure is needed to identify/verify squares of the basis element s 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 784 "squaremodf:=proc(a1::\{clibasmon ,climon,clipolynom\},a2::idempotent) \nlocal p;global B;\noptions `Cop yright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2007`;\n##### ########################################\nif nargs<>2 then \n error \+ \"two arguments needed of type clibasmon, or climon, or clipolynom, an d 'idempotent'\" \nend if;\nif a1=a2 then return 1 elif\n not type(B ,matrix) then error \"matrix must be assigned to B\" \nend if;\np:=cmu l(a1,a1):\nif expand(p-a2)=0 then return 1 elif\n expand(p+a2)=0 the n return -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 proc:\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 505 "RHnumber:=proc(a1::integer)\noptions `Copyright (c) \+ 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 20, 2007`;\n################ #############################\nif member(a1,\{0,1,2\}) then return a1 \+ elif\n a1=3 then return 2 elif\n member(a1,\{4,5,6,7\}) then retur n 3 elif\n a1>=8 then return RHnumber(a1-8)+4 elif\n a1<0 then ret urn 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 474 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2007`;\n########### ##################################\nif nargs=0 then a1:=`B` else a1:=a rgs end if:\nif not type(a1,\{list(nonnegint),matrix\}) then\n WARNI NG(\"to find out about Clifford algebra Cl_\{p,q\} try clidata([p,q]) \+ or 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 r ead in when needed by the procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" }{MPLTEXT 1 0 16601 ":=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-2008 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`,remember;\ndescription `Last revised: December 20, 2007` ;\n#############################################\n#K = field of spinor repesentation, it is R, C, or H depending on [p,q]\n#dimoverK = dimen sion of spinor representation over the field K\n#dimoverR = dimension \+ of spinor representation over the reals R\n#numfact = number of idempo tent factors in any primitive idempotent\n#SBgens = basis monomials ge nerating 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 \+ of -1 in the diagonal form Q of B\n#struct = structure of Cl(Q) is 'si mple' 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 assi gned(B)<<<\nif not type(B,matrix) then \n error \"matrix must be ass igned 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 \+ type(args[1],matrix) then \n p:=Bsignature(args)[1]; q:=Bsignat ure(args)[2] \n else \n error \"wrong argument types in 'clid ata'\" \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:=f loor((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*n i; else\n K:='quaternionic'; dimoverR:=4*ni; dimoverK:=ni \nend i f;\nnumfact:=q-RHnumber(q-p);\nif modp((p-q) = 1,4) then struct:='semi simple' \n else struct:='simple' \nend if;\nprimidemp:=table():SBgen s:=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''((1/2)*(Id+e1),(1/2)*( Id+e3we4));\nSBgens[[3,1]]:=[Id,e2,e3,e2we3];\nFBgens[[3,1]]:=[Id];\nS BKgens[[3,1]]:=SBgens[[3,1]];\n\nprimidemp[[0,6]]:=\n''cmulQ''((1/2)*( Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6));\nSBgens[[0,6]]: =[Id,e1,e2,e3,e4,e5,e6,e1we5];\nFBgens[[0,6]]:=[Id];\nSBKgens[[0,6]]:= SBgens[[0,6]];\n\nprimidemp[[3,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2) *(Id+e2we5),(1/2)*(Id+e3we6));\nSBgens[[3,3]]:=[Id,e1,e2,e3,e1we2,e1we 3,e2we3,e1we2we3];\nFBgens[[3,3]]:=[Id];\nSBKgens[[3,3]]:=SBgens[[3,3] ];\n\nprimidemp[[4,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we5),(1/ 2)*(Id+e4we6));\nSBgens[[4,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we 4];\nFBgens[[4,2]]:=[Id];\nSBKgens[[4,2]]:=SBgens[[4,2]];\n\nprimidemp [[4,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7 ),(1/2)*(Id+e4we8));\nSBgens[[4,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4 ,e2we3,e2we4,e3we4,e1we2we3,\n e1we2we4,e1we3we4,e2we3we4,e1we2we3we4] ;\nFBgens[[4,4]]:=[Id];\nSBKgens[[4,4]]:=SBgens[[4,4]];\n\nprimidemp[[ 5,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we6),(1/2)*(Id+e4we7),(1/ 2)*(Id+e5we8));\nSBgens[[5,3]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we 4,e3we5,e4we5,e2we3we4,\ne2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBg ens[[5,3]]:=[Id];\nSBKgens[[5,3]]:=SBgens[[5,3]];\n\nprimidemp[[8,0]]: =\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we 7),\n (1/2)*(Id+e2we4we6we8));\nSBgens[[8,0]]:=[Id,e2,e3,e4,e 5,e6,e7,e8,e2we3,e2we4,e2we5,e2we6,e2we7,\ne2we8,e3we8,e2we3we8];\nFBg ens[[8,0]]:=[Id];\nSBKgens[[8,0]]:=SBgens[[8,0]];\n\nprimidemp[[1,7]]: =\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e4we5we6),(1/2)*(Id+e2we5we 7),\n (1/2)*(Id+e1we8));\nSBgens[[1,7]]:=[Id,e1,e2,e3,e4,e5,e 6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,\ne1we7,e2we6,e1we2we6];\nFBgens[[1 ,7]]:=[Id];\nSBKgens[[1,7]]:=SBgens[[1,7]];\n\nprimidemp[[0,8]]:=\n''c mulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n \+ (1/2)*(Id+e3we6we7));\nSBgens[[0,8]]:=\n[Id,e1,e2,e3,e4,e5,e6 ,e7,e8,e1we8,e2we8,e3we8,e4we8,e5we8,e6we8,e7we8];\nFBgens[[0,8]]:=[Id ];\nSBKgens[[0,8]]:=SBgens[[0,8]];\n\n#Complex, simple (15 cases)\npri midemp[[0,1]]:=Id; #complex numbers\nSBgens[[0,1]]:=[Id,e1];\nFBgens[ [0,1]]:=[Id,e1];\nSBKgens[[0,1]]:=[Id,e1];\n\nprimidemp[[1,2]]:=(1/2)* (Id+e1we3);\nSBgens[[1,2]]:=[Id,e1,e2,e1we2];\nFBgens[[1,2]]:=[Id,e2]; \nSBKgens[[1,2]]:=[Id,e1];\n\nprimidemp[[3,0]]:=(1/2)*(Id+e1);\nSBgens [[3,0]]:=[Id,e2,e3,e2we3];\nFBgens[[3,0]]:=[Id,e2we3];\nSBKgens[[3,0]] :=[Id,e2];\n\nprimidemp[[0,5]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)* (Id+e3we4we5));\nSBgens[[0,5]]:=[Id,e1,e2,e3,e4,e5,e1we4,e1we5];\nFBge ns[[0,5]]:=[Id,e3];\nSBKgens[[0,5]]:=[Id,e1,e4,e1we4];\n\nprimidemp[[2 ,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2)*(Id+e2we5));\nSBgens[[2,3]]:= [Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[2,3]]:=[Id,e3];\nSB Kgens[[2,3]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[4,1]]:=\n''cmulQ''((1/2) *(Id+e1),(1/2)*(Id+e4we5));\nSBgens[[4,1]]:=[Id,e2,e3,e4,e2we3,e2we4,e 3we4,e2we3we4];\nFBgens[[4,1]]:=[Id,e2we3];\nSBKgens[[4,1]]:=[Id,e2,e4 ,e2we4];\n\nprimidemp[[1,6]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(I d+e4we5we6),(1/2)*(Id+e1we7));\nSBgens[[1,6]]:=[Id,e1,e2,e3,e4,e5,e6,e 1we2,e1we3,e1we4,e1we5,e1we6,e2we5, \+ e2we6,e1we2we5,e1we2we6]; \nFBgens[[1,6]]:=[Id,e4];\nSBKg ens[[1,6]]:=[Id,e1,e2,e5,e1we2,e1we5,e2we5,e1we2we5];\n\nprimidemp[[3, 4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7)); \nSBgens[[3,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4, \n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4]; \n FBgens[[3,4]]:=[Id,e4];\nSBKgens[[3,4]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we 3,e1we2we3];\n\nprimidemp[[5,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+ e4we6),(1/2)*(Id+e5we7));\nSBgens[[5,2]]:=[Id,e2,e3,e4,e5,e2we3,e2we4, e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2we3we5,e2we4we5,e 3we4we5,e2we3we4we5]; \nFBgens[[5,2]]:=[Id,e2we3];\nSBKgens[[5,2]]:=[I d,e2,e4,e5,e2we4,e2we5,e4we5,e2we4we5];\n\nprimidemp[[7,0]]:=\n''cmulQ ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7));\nSBge ns[[7,0]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,\n \+ e4we6,e4we7,e2we4we6,e2we4we7]; \nFBgens[[7,0]]:=[Id,e2we3] ;\nSBKgens[[7,0]]:=[Id,e2,e4,e6,e2we4,e2we6,e4we6,e2we4we6];\n\nprimid emp[[0,9]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)* (Id+e1we4we6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,9]]:=\n[Id, e1,e2,e3,e4,e5,e6,e7,e8,e9,e1we8,e1we9,e2we8,e2we9,e3we8,e3we9,\n e4we 8,e4we9,e5we8,e5we9,e6we8,e6we9,e7we8,e7we9,e8we9,e1we8we9,\n e2we8we9 ,e3we8we9,e4we8we9,e5we8we9,e6we8we9,e7we8we9];\nFBgens[[0,9]]:=[Id,e8 we9];\nSBKgens[[0,9]]:=[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3we8,e 4we8,\n e5we8,e6we8,e7we8];\n\nprimidemp[[2,7]]:=\n''c mulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e5we6we7),(1/2)*(Id+e1we8),\n \+ (1/2)*(Id+e2we9));\nSBgens[[2,7]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e1 we2,e1we3,e1we4,e1we5,e1we6,e1we7,e2we3,\n e2we4,e2we5,e2we6,e2we7,e3w e6,e3we7,e1we2we3,e1we2we4,e1we2we5,\n e1we2we6,e1we2we7,e1we3we6,e1we 3we7,e2we3we6,e2we3we7,e1we2we3we6,\n e1we2we3we7];\nFBgens[[2,7]]:=[I d,e5];\nSBKgens[[2,7]]:=\n[Id,e1,e2,e3,e6,e1we2,e1we3,e1we6,e2we3,e2we 6,e3we6,e1we2we3,e1we2we6,e1we3we6,\n e2we3we6,e1we2we3we6];\n\nprimid emp[[4,5]]:=\n''cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2)*(Id+e3 we8),(1/2)*(Id+e4we9));\nSBgens[[4,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1w e3,e1we4,e1we5,e2we3,e2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we 4,e1we2we5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3 we4we5,e1we2we3we4,e1we2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5, e1we2we3we4we5];\nFBgens[[4,5]]:=[Id,e5];\nSBKgens[[4,5]]:=\n[Id,e1,e2 ,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,e1we2we3,e1we2we4,\n e1we3w e4,e2we3we4,e1we2we3we4];\n\nprimidemp[[6,3]]:=\n''cmulQ''((1/2)*(Id+e 1),(1/2)*(Id+e4we7),(1/2)*(Id+e5we8),(1/2)*(Id+e6we9));\nSBgens[[6,3]] :=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5 ,\n e4we6,e5we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6, \n e3we4we5,e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we 3we5we6,e2we4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6,3]]:=[Id,e 2we3];\nSBKgens[[6,3]]:=\n[Id,e2,e4,e5,e6,e2we4,e2we5,e2we6,e4we5,e4we 6,e5we6,e2we4we5,e2we4we6,\n e2we5we6,e4we5we6,e2we4we5we6];\n\nprimid emp[[8,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id +e4we5we6we7),\n (1/2)*(Id+e8we9));\nSBgens[[8,1]]:=\n[Id,e2, e3,e4,e5,e6,e7,e8,e2we3,e2we4,e2we5,e2we6,e2we7,e2we8,e3we8,\n e4we6,e 4we7,e4we8,e5we8,e6we8,e7we8,e2we3we8,e2we4we6,e2we4we7,\n e2we4we8,e2 we5we8,e2we6we8,e2we7we8,e4we6we8,e4we7we8,e2we4we6we8,\n e2we4we7we8] ;\nFBgens[[8,1]]:=[Id,e2we3];\nSBKgens[[8,1]]:=\n[Id,e2,e4,e6,e8,e2we4 ,e2we6,e2we8,e4we6,e4we8,e6we8,e2we4we6,e2we4we8,\n e2we6we8,e4we6we8, e2we4we6we8];\n\n#Quaternionic, simple (12 cases)\nprimidemp[[0,2]]:=I d; #quaternions\nSBgens[[0,2]]:=[Id,e1,e2,e1we2];\nFBgens[[0,2]]:=[Id, e1,e2,e1we2];\nSBKgens[[0,2]]:=[Id];\n\nprimidemp[[0,4]]:=(1/2)*(Id+e1 we2we3);\nSBgens[[0,4]]:=[Id,e1,e2,e3,e4,e1we4,e2we4,e3we4];\nFBgens[[ 0,4]]:=[Id,e1,e1we3,e3];\nSBKgens[[0,4]]:=[Id,e4];\n\nprimidemp[[1,3]] :=(1/2)*(Id+e1we4);\nSBgens[[1,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1w e2we3];\nFBgens[[1,3]]:=[Id,e2,e3,e2we3];\nSBKgens[[1,3]]:=[Id,e1];\n \nprimidemp[[4,0]]:=(1/2)*(Id+e1);\nSBgens[[4,0]]:=[Id,e2,e3,e4,e2we3, e2we4,e3we4,e2we3we4];\nFBgens[[4,0]]:=[Id,e2we3,e2we4,e3we4];\nSBKgen s[[4,0]]:=[Id,e2];\n\nprimidemp[[1,5]]:=\n''cmulQ''((1/2)*(Id+e2we3we4 ),(1/2)*(Id+e1we6));\nSBgens[[1,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1 we4,e1we5,e2we5,e3we5,\n e4we5,e1we2we5,e1we3we5,e1we4w e5];\nFBgens[[1,5]]:=[Id,e2,e2we4,e4];\nSBKgens[[1,5]]:=[Id,e1,e5,e1we 5];\n\nprimidemp[[2,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6) );\nSBgens[[2,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4 ,\n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4];\n FBgens[[2,4]]:=[Id,e3,e4,e3we4];\nSBKgens[[2,4]]:=[Id,e1,e2,e1we2];\n \nprimidemp[[5,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we6));\nSBge ns[[5,1]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,\n \+ e2we3we4,e2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[ 5,1]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[5,1]]:=[Id,e2,e5,e2we5];\n\np rimidemp[[6,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5));\nS Bgens[[6,0]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,e4we6, \n e5we6,e2we3we6,e2we4we6,e2we5we6];\nFBgens[[6,0]]:=[ Id,e2we3,e3we5,e2we5];\nSBKgens[[6,0]]:=[Id,e2,e6,e2we6];\n\nprimidemp [[2,6]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e1we7),(1/2)*(Id+e2 we8));\nSBgens[[2,6]]:=\n[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5 ,e1we6,e2we3,e2we4,e2we5,\n e2we6,e3we6,e4we6,e5we6,e1we2we3,e1we2we4, e1we2we5,e1we2we6,e1we3we6,\n e1we4we6,e1we5we6,e2we3we6,e2we4we6,e2we 5we6,e1we2we3we6,e1we2we4we6,\n e1we2we5we6];\nFBgens[[2,6]]:=[Id,e3,e 3we5,e5];\nSBKgens[[2,6]]:=[Id,e1,e2,e6,e1we2,e1we6,e2we6,e1we2we6];\n \nprimidemp[[3,5]]:=\n''cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2 )*(Id+e3we8));\nSBgens[[3,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4, e1we5,e2we3,e2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we 5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1 we2we3we4,e1we2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3w e4we5];\nFBgens[[3,5]]:=[Id,e4,e5,e4we5];\nSBKgens[[3,5]]:=[Id,e1,e2,e 3,e1we2,e1we3,e2we3,e1we2we3];\n\nprimidemp[[6,2]]:=\n''cmulQ''((1/2)* (Id+e1),(1/2)*(Id+e5we7),(1/2)*(Id+e6we8));\nSBgens[[6,2]]:=\n[Id,e2,e 3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5 we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5, e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we 4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6,2]]:=[Id,e2we3,e2we4,e 3we4];\nSBKgens[[6,2]]:=[Id,e2,e5,e6,e2we5,e2we6,e5we6,e2we5we6];\n\np rimidemp[[7,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2 )*(Id+e7we8));\nSBgens[[7,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2w e5,e2we6,e2we7,e3we6,e3we7,e4we6,\n e4we7,e5we6,e5we7,e6we7,e2we3we6,e 2we3we7,e2we4we6,e2we4we7,e2we5we6,\n e2we5we7,e2we6we7,e3we6we7,e4we6 we7,e5we6we7,e2we3we6we7,e2we4we6we7,\n e2we5we6we7];\nFBgens[[7,1]]:= [Id,e2we3,e3we5,e2we5];\nSBKgens[[7,1]]:=[Id,e2,e6,e7,e2we6,e2we7,e6we 7,e2we6we7];\n\n#Real, semi-simple (8 cases)\nprimidemp[[1,0]]:=(1/2)* (Id+e1);\nSBgens[[1,0]]:=[Id];\nFBgens[[1,0]]:=[Id];\nSBKgens[[1,0]]:= SBgens[[1,0]];\n\nprimidemp[[2,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(I d+e2we3));\nSBgens[[2,1]]:=[Id,e2];\nFBgens[[2,1]]:=[Id];\nSBKgens[[2, 1]]:=SBgens[[2,1]];\n\nprimidemp[[3,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/ 2)*(Id+e2we4),(1/2)*(Id+e3we5));\nSBgens[[3,2]]:=[Id,e2,e3,e2we3];\nFB gens[[3,2]]:=[Id];\nSBKgens[[3,2]]:=SBgens[[3,2]];\n\nprimidemp[[0,7]] := ''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we 6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,7]]:=[Id,e1,e2,e3,e4,e 5,e6,e7];\nFBgens[[0,7]]:=[Id];\nSBKgens[[0,7]]:=SBgens[[0,7]];\n\npri midemp[[4,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we5),(1/2)*(Id+e3 we6),\n (1/2)*(Id+e4we7));\nSBgens[[4,3]]:=[Id,e2,e3,e4,e2we3 ,e2we4,e3we4,e2we3we4];\nFBgens[[4,3]]:=[Id];\nSBKgens[[4,3]]:=SBgens[ [4,3]];\n\nprimidemp[[9,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3 we4we5),1/2*(Id+e2we3we6we7),\n (1/2)*(Id+e2we3we8we9),(1/2)* (Id+e2we4we6we8));\nSBgens[[9,0]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3 ,e2we4,e2we5,e2we6,e2we7,e2we8,e2we9];\nFBgens[[9,0]]:=[Id];\nSBKgens[ [9,0]]:=SBgens[[9,0]];\n\nprimidemp[[5,4]]:=\n''cmulQ''((1/2)*(Id+e1), (1/2)*(Id+e2we6),(1/2)*(Id+e3we7),\n (1/2)*(Id+e4we8),(1/2)*( Id+e5we9));\nSBgens[[5,4]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3 we5,e4we5,e2we3we4, e2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[ 5,4]]:=[Id];\nSBKgens[[5,4]]:=SBgens[[5,4]];\n\nprimidemp[[1,8]]:=\n'' cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),1/2*(Id+e2we3we6we7),\n \+ (1/2)*(Id+e2we3we8we9),(1/2)*(Id+e2we4we6we8));\nSBgens[[1,8]] :=[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2we7,e2we8,e2we 9];\nFBgens[[1,8]]:=[Id];\nSBKgens[[1,8]]:=SBgens[[1,8]];\n\n#Complex, semi-simple - none\n\n#Quaternionic, semi-simple (5 cases)\nprimidemp [[0,3]]:=(1/2)*(Id+e1we2we3);\nSBgens[[0,3]]:=[Id,e1,e2,e3];\nFBgens[[ 0,3]]:=[Id,e1,e2,e1we2];\nSBKgens[[0,3]]:=[Id];\n\nprimidemp[[1,4]]:= \n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e1we5));\nSBgens[[1,4]]:=[Id ,e1,e2,e3,e4,e1we2,e1we3,e1we4];\nFBgens[[1,4]]:=[Id,e2,e3,e2we3];\nSB Kgens[[1,4]]:=[Id,e1];\n\nprimidemp[[5,0]]:=\n''cmulQ''((1/2)*(Id+e1), (1/2)*(Id+e2we3we4we5));\nSBgens[[5,0]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e 2we5];\nFBgens[[5,0]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[5,0]]:=[Id,e2 ];\n\nprimidemp[[2,5]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e1we 6),(1/2)*(Id+e2we7));\nSBgens[[2,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e 1we4,e1we5,\n e2we3,e2we4,e2we5,e1we2we3,e1we2we4,e1we2 we5];\nFBgens[[2,5]]:=[Id,e3,e3we5,e5];\nSBKgens[[2,5]]:=[Id,e1,e2,e1w e2];\n\nprimidemp[[6,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4 we5),(1/2)*(Id+e6we7));\nSBgens[[6,1]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4 ,e2we5,e2we6,e3we6,\n e4we6,e5we6,e2we3we6,e2we4we6,e2 we5we6];\nFBgens[[6,1]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[6,1]]:=[Id, e2,e6,e2we6];\n\nprimidemp[[7,2]]:=''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e 2we8),\n (1/2)*(Id+e3we9),(1/2)*(Id+e4we5we6w e7));\nSBgens[[7,2]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2 we7,\ne3we4,e3we5,e3we6,e3we7,e4we5,e4we6,e4we7,e2we3we4,e2we3we5,e2we 3we6,\ne2we3we7,e2we4we5,e2we4we6,e2we4we7,e3we4we5,e3we4we6,e3we4we7, \ne2we3we4we5,e2we3we4we6,e2we3we4we7];\nFBgens[[7,2]]:=[Id,e4we5,e5we 7,e4we7];\nSBKgens[[7,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\n \nprimidemp[[3,6]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),\n \+ (1/2)*(Id+e3we5),(1/2)*(Id+e6we7we8we9));\nSBgens[[3,6]]:=[Id,e2, e3,e6,e7,e8,e9,e2we3,e2we6,e2we7,e2we8,e2we9,e3we6,e3we7,\ne3we8,e3we9 ,e6we7,e6we8,e6we9,e2we3we6,e2we3we7,e2we3we8,e2we3we9,e2we6we7,\ne2we 6we8,e2we6we9,e3we6we7,e3we6we8,e3we6we9,e2we3we6we7,e2we3we6we8,\ne2w e3we6we9];\nFBgens[[3,6]]:=[Id,e6we7,e7we9,e6we9];\nSBKgens[[3,6]]:=[I d,e2,e3,e6,e2we3,e2we6,e3we6,e2we3we6];\n\nreturn ([K,dimoverK,struct, primidemp[[p,q]],\n SBgens[[p,q]],FBgens[[p,q]],SBKgens[[p,q]]] );\nend proc:\n##################\nreturn clidata2(a1); #### <<< Retur n from 'clidata'\nend proc: #### <<< End of 'clidata'\n" }}{PARA 258 " " 0 "" {TEXT -1 18 "No. 53. Procedure " }{TEXT 340 10 "Bsignature" } {TEXT -1 313 " finds the signature of the form B assuming that B is a diagonal matrix or a symmetric matrix. It returns a list L with two o r three integers depending on whether B is non-degenerate or degenerat e, that is, L=[p,q] or L=[p,q,d]. Here d = dim(rad B), and p (q) denot es number of +1 (-1) in the diagonal form of B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 42 "Typical use: Bsignature (); Bsignature(B);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1290 "Bsignatur e:=proc() local curB,Bdiag,pos,neg,deg,i,L;global B;\noptions `Copyrig ht (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2007`;\n######### ####################################\nif nargs=0 then\n if not type (B,matrix) then\n error \"square matric should be assigned to B \+ first\"\n else curB:=B \n end if;\nelif nargs=1 then\n if not type(evalm(args[1]),matrix) then\n error \"argument entered is \+ not a matrix\"\n else curB:=evalm(args[1]) \n end if;\nelse err or \"wrong number of arguments. See ?Bsignature for more help.\" \nend if;\nBdiag:=diagonalize(evalm(curB-(curB-linalg[transpose](curB))/2)) ;\nif not type(Bdiag,diagmatrix) then \n error \"unable to diagonali ze symmetric part of the input\"\nend if;\nL:=map(signum,[seq(Bdiag[i, i],i=1..linalg[coldim](Bdiag))]):\nif not type(L,list(integer)) then\n error \"unable to determine signs of expressions %1\",L\nend if;\np os:=0:neg:=0:deg:=0:\nfor i from 1 to linalg[coldim](Bdiag) do\nif L[i ]<>0 then\n if evalf(L[i])>0 then pos:=pos+1 elif\n evalf(L[i]) <0 then neg:=neg+1 else\n error \"unable to determine sign of %1 \",Bdiag[i,i]\n end if;\nelse deg:=deg+1;\nend if;\nend do;\nif deg= 0 then return [pos,neg] else return [pos,neg,deg] end if;\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 157 "No. 51. Spinor representation of C l(Q) in S=Cl(Q)f and S=fCl(Q) over the field K of the reals, complexes , or quaternions when Cl(Q) is simple.\nThe procedure " }{TEXT 341 11 "spinorKrepr" }{TEXT -1 183 " finds matrix representation of any Cliff ord polynomial in a minimal left or right ideal in Cl(Q) generated by \+ a primitive idempotent f. The procedure is invoked with four argument s:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(1) the first argument is an algebraic expression of type clipolynom; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 " (2) the second argument is a list of generators of the minimal ideal S considered as a K-vector space. For standard f equal to clidata()[4] these generators are stored under clidata()[6] for the given form B; \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 241 " (3) the third argument is a list of basis elements spanning K. For st andard f equal to clidata()[4] these generators are stored under clida ta()[5]. Matrices computed by 'spinorKrepr' will be expressed in term s of these basis elements of K;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 111 "(4) the fourth argument is a one of th e strings 'left' or 'right' depending whether the ideal is left or rig ht." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard input is used, i.e., the second argument equals cli data()[7] and the third argument equals clidata()[5], the procedure tr ies to use previously computed matrices representing 1-vectors. These matrices are stored as .m files with the names 'matrealL.m', 'matcomp L.m', 'matquatL.m' for real, complex, and quaternionic matrices in the left-regular spinor representation. If the first argument entered bel ongs to Cl(Q) whose 1-vector matrices have been previously computed, t he procedure calls 'matKrepr' which makes use of these pre-computed ma trices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 470 "Typical use: dim:=4:B:=linalg[diag](1,-1,-1,-1):clibasis:=cbas is(dim):data:=clidata():\n f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n Kb asis:=spinorKbasis(sbasis[2],f,fbasis[2],'left');\n \+ spinorKrepr(e1,Kbasis[1],fbasis[2],'left');\n \+ spinorKrepr(2*e1+Id-3*e1we2we3,Kbasis[1],fbasis[2],'left');\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 5599 "spinorKrepr:=proc(a1::\{clibasmon ,climon,clipolynom,numeric\},\n a2::list(\{clibasmon, climon,clipolynom\}),\n a3::list(\{clibasmon,climon,c lipolynom\}),\n a4::\{string,symbol\})\nlocal i,j,k,r eprdim,r,a,FBgens,eq,hbasis,g,terms,sys,vars,sol,M,pqsig,pq,\n fl ag_left,data,Kbasis,f,v,pqmod8,n,expr,flag_simple;\nglobal B,_prolevel ,_shortcut_in_spinorKrepr,matrealL,matrealR,matcompL,matcompR,matquatL ,matquatR;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2007`;\n#############################################\nif n ot type(B,diagmatrix) then \n error \"bilinear form B must be define d as diagonal matrix\" \nelse pq:=Bsignature() \nend if;\n############ ######################\nif pq[1]-pq[2]=1 mod 4 then flag_simple:=false else flag_simple:=true end if;\n##################################\ni f maxindex(a1) > linalg[coldim](B) then\n error \"maximum index %1 f ound in input is greater than the size %2 of the current bilinear form B\", maxindex(a1),linalg[coldim](B) \nend if;\n###################### ############\nhbasis:=a2:FBgens:=a3:reprdim:=nops(hbasis):n:=nops(FBge ns):\n##################################\nif member(a4,\{'left',\"left \"\}) then flag_left:=true elif\n member(a4,\{'right',\"right\"\}) t hen flag_left:=false else\n error \"last argument expected to be 'le ft' or 'right' but received %1 instead\",a4\nend if; \n############### #########################################################\n#This proce dure gives faithful representations when Cl(p,q) is simple\n#and unfai thful when Cl(p,q) is semi-simple. In order to get faithful\n#represen tations in this last case, use 'matKrepr' or use this procedure\n#as s hown in examples.\n################################################### #####################\n#if flag_simple then\nif a1=Id then return lin alg[diag](1$reprdim) elif\n a1=-Id then return linalg[diag](-1$reprd im) elif\n type(a1,numeric) then return linalg[diag](a1$reprdim) \ne nd if;\n############################################################## ##########\n#when _shortcut_in_spinorKrepr is false, 'matKrepr' is not used\n############################################################### #########\nif _shortcut_in_spinorKrepr then\n pqmod8:=(pq[1]-pq[2]) \+ mod 8:\n if member(pqmod8,\{0,1,2\}) and flag_left then \n #if \+ not assigned(matrealL) then readlib(matrealL) end if;\n pqsig:=m ap(op,[indices(matrealL)]) \n elif member(pqmod8,\{0,1,2\}) and not \+ flag_left then\n #if not assigned(matrealR) then readlib(matrealR ) end if;\n pqsig:=map(op,[indices(matrealR)]) \n elif member( pqmod8,\{3,7\}) and flag_left then \n #if not assigned(matcompL) \+ then readlib(matcompL) end if;\n pqsig:=map(op,[indices(matcompL )]) \n elif member(pqmod8,\{3,7\}) and not flag_left then\n #if not assigned(matcompR) then readlib(matcompR) end if;\n pqsig:= map(op,[indices(matcompR)]) \n elif member(pqmod8,\{4,5,6\}) and fla g_left then \n #if not assigned(matquatL) then readlib(matquatL) \+ end if;\n pqsig:=map(op,[indices(matquatL)]) \n elif member(pq mod8,\{4,5,6\}) and not flag_left then\n #if not assigned(matquat R) then readlib(matquatR) end if;\n pqsig:=map(op,[indices(matqu atR)]) \n end if;\n#####################################\n if memb er(pq,pqsig) then \n data:=clidata(pq):f:=eval(eval(data[4]) ):\n g:='g': \n if flag_left then Kbasis:=[seq(cmulQ(g, f),g=data[7])] \n else Kbasis:=[seq(cmulQ(f,g),g=da ta[7])] \n end if; \n if hbasis=Kbasis then\n if FBg ens=data[6] then return matKrepr(a1,a4) end if; \n end if;\n \+ end if;\nend if;\n#####################################\n#Continue f inding the matrix\n#####################################\na:='a':j:='j ':k:='k':\nif flag_left then\n expr:=add(add(a[j,k]*cmulQ(hbasis[j], FBgens[k]),j=1..reprdim),k=1..n);\n for j from 1 to reprdim do r[j]: =add(a[j,k] * FBgens[k],k=1..n) end do; \n for i from 1 to reprdim do\n eq:=expand(cmulQ(a1,hbasis[i])-expr);\n terms:=clite rms(eq);\n eq:=clicollect(eq,terms);\n sys:=\{coeffs(eq,te rms)\}:\n vars:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\};\n \+ sol:=solve(sys,vars);\n if sol=NULL then \nerror \"unable to f ind matrix due input error: check if the last argument matches the one previously used in 'spinorKbasis'\"\n end if; \n v[i]:=co nvert([seq(subs(sol,r[j]),j=1..reprdim)],vector);\n end do:\nM:=lina lg[transpose](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\nret urn subs(Id=1,evalm(M));\nelse \n expr:=add(add(a[j,k]*cmulQ(FBg ens[k],hbasis[j]),j=1..reprdim),k=1..n);\n for j from 1 to reprdim d o r[j]:=add(a[j,k] * FBgens[k],k=1..n) end do; \n for i from 1 to \+ reprdim do \n eq:=expand(cmulQ(hbasis[i],a1)-expr);\n \+ terms:=cliterms(eq);\n eq:=clicollect(eq,terms);\n sys:= \{coeffs(eq,terms)\}:\n vars:=\{seq(seq(a[j,k],k=1..n),j=1..repr dim)\};\n sol:=solve(sys,vars);\n if sol=NULL then \nerror \"unable to find matrix due to input error: check if the last argumen t matches the one previously used in 'spinorKbasis'\"\n end if; \+ \n v[i]:=convert([seq(subs(sol,r[j]),j=1..reprdim)],vector);\n \+ end do:\n############################################################ ################\n#The next line produces wrong results in some quat r ight cases:\n#M:=linalg[transpose](linalg[stackmatrix](seq(eval(v[i]), i=1..reprdim)));\n#################################################### ########################\nM:=linalg[stackmatrix](seq(eval(v[i]),i=1..r eprdim));\nreturn subs(Id=1,evalm(M));\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 52. Procedure " }{TEXT 342 5 "rmulm" } {TEXT -1 110 " extends the following multiplications to matrix entries : cmul, cmulQ, wedge, omul, `&r`, `&*`\n " }}{PARA 258 " " 0 "" {TEXT -1 271 "In this last case, the commutative multiplication `*` is applied to the matrix entries. It takes three arguments or f our arguments. If the fourth argument is used, it is either of type na me/symbol/array/matrix or a numeric multiple of such type, for example , K or -K. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 90 "To apply Clifford multiplication 'cmul[B]' to matrix entr ies enter one of the following: " }}{PARA 258 "" 0 "" {TEXT -1 143 "r mulm(M1, M2, cmul); rmulm(M1,M2,cmul,B);rmulm(M1,M2,cmul,K);rmulm(M1,M 2,cmul,-K);\n&cm(M1, M2); &cm[B](M1,M2);&cm[K](M1,M2);&cm[-K](M1,M2); \+ \n" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply Clifford multiplicatio n 'cmulQ[B]' to matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 235 "rmulm(M1, M2, cmulQ); rmulm(M1,M2,cmulQ,B);r mulm(M1,M2,cmulQ,K);rmulm(M1,M2,cmulQ,-K);\n&cQm(M1, M2); &cQm[B](M1,M 2);&cQm[K](M1,M2);&cQm[-K](M1,M2); \n\nTo apply wedge multiplication 'wedge' to matrix entries enter one of the following:" }}{PARA 258 " " 0 "" {TEXT -1 60 "rmulm(M1, M2, `&w`); M1 &wm M2; rmulm(M1, M2, wedge); " }}{PARA 258 "" 0 "" {TEXT -1 113 "\nTo apply some generic \+ possibly non-commutative multiplication `&r` to matrix entries enter o ne of the following:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmulm(M1, M2, ` &r`); M1 &rm M2; " }}{PARA 258 "" 0 "" {TEXT -1 98 "\nTo apply st andard commutative scalar multiplication to matrix entries enter one o f the following:" }}{PARA 258 "" 0 "" {TEXT -1 39 "rmulm(M1, M2, `&*`) ; M1 &* M2; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 70 "Similarly for matrices with quaternionic entries w e have as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 89 "To apply quaternionic multiplication 'qmul' to mat rix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 72 "rmulm(M1, M2, `&q`); M1 &qm M2; rmulm(M1,M2,qmul);\n\nTypica l use: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 73 "M1 := linalg[matrix](2, 2, [Id + e1we2, e2 + e3, e1 - e2, Id + \+ e2we3]); " }}{PARA 258 "" 0 "" {TEXT -1 137 "M2 := linalg[matrix](2, \+ 2, [Id + e2we3, e3 + e4, e1 - e2, Id + e1we3]); \n\nM1 := linalg[matr ix](2, 2, [Id + 2*qi + 3*qj, qi, qi + qj]); " }}{PARA 258 "" 0 "" {TEXT -1 58 "M2 := linalg[matrix](2, 2, [Id + qi, qj, qk, Id - qi]); \+ \n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 7271 "rmulm:=proc(a1::\{list(ma trix),dfmatrix,matrix,clipolynom,cliscalar,clibasmon,climon\},\n \+ a2::\{list(matrix),dfmatrix,matrix,clipolynom,cliscalar,clibasmo n,climon\},\n a3::\{name,function,procedure,symbol\}) \nloc al ar1,ar2,L,newL,m1,m2,r1,r2,c1,c2,i,j,k,M,reset_prolevel,coB,nameB,l name,tail,out;\nglobal _prolevel, `&r`;\noptions `Copyright (c) 1995-2 008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: December 20, 2007`;\n###################### #######################\n################################\nif has(0,ma p(simplify,[a1,a2])) then return 0 end if;\n########################## ###### \nif nargs=3 then\n coB:=1:\n nameB:=`B`: \n lname:=` B`: \nelif nargs=4 then\n if type(eval(args[4]),\{name,symbol,matri x,array\}) then\n coB:=1:\n nameB:=args[4];\n lname: =args[4];\n elif type(eval(args[4]),`&*`(numeric,\{name,symbol,matr ix,array\})) then\n coB:=op(select(type,\{op(args[4])\},numeric) );\n nameB:=op(remove(type,\{op(args[4])\},numeric));\n ln ame:=args[4]:\n else \n error \"wrong type of fourth argument %1 in rmulm\",args[4] \n end if;\nelse\n error \"three or four a rguments expected in rmulm\"\nend if;\n############################### #\ntail:=op(subsop(1=NULL,subsop(1=NULL,[args])));\n################## ##############\n#return (a1,a2,a3,coB,nameB,lname,tail);\n############ ####################\nif _prolevel then reset_prolevel:=true:\n \+ _prolevel:=false:\n else reset_prolevel:=f alse\nend if; \n################################\nif ty pe(a1,matrix) and not type(a1,\{dfmatrix,climatrix,cliscalar\}) and \+ \n type(a2,matrix) and not type(a2,\{dfmatrix,climatrix,cliscalar\}) \nthen \n _prolevel:=reset_prolevel:\n return evalm(a1 &* a2) \+ \n end if;\n################################\nif type(a1,list(matrix)) and type(a2,list(matrix)) then \n if nops(a1)<>nops(a2) then error \+ \"received lists of unequal lengths\" \n else\n i:='i':\n \+ _prolevel:=reset_prolevel:\n return [seq(procname(a1[i],a2[i],tai l),i=1..nops(a1))]\n end if;\nend if;\n############################# ###\nif type(a1,dfmatrix) and type(a2,dfmatrix) then\n return cdfmat rix(procname(ddfmatrix(a1),ddfmatrix(a2),tail))\nend if;\n############ ####################\nif type(a1,\{clipolynom,cliscalar,clibasmon,clim on\}) then \n if type(a2,list(matrix)) then return (map2(procname,ar gs)) \n elif type(a2,dfmatrix) then \n return subs(Id=1,conve rt(map2(procname,a1,ddfmatrix(a2),tail),dfmatrix))\n end if\nend if; \n################################\nif type(a2,\{clipolynom,cliscalar, clibasmon,climon\}) then \n if type(a1,list(matrix)) then return map (procname,args) \n elif type(a1,dfmatrix) then \n return subs (Id=1,convert(map(procname,ddfmatrix(a1),a2,tail),dfmatrix))\n end i f\nend if;\n################################\n#if not member(a3,\{`&*` ,`&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) then \n# error \"third argument must be one of the following: cmul, cmulQ, w edge, qmul, omul, &*, &r but received %1 instead\",a3 #\n#end if;\n### #############################\nif member(a3,\{`&*`\}) and \n (type(a 1,\{clibasmon,climon,clipolynom,climatrix\}) or\n type(a2,\{clibasm on,climon,clipolynom,climatrix\})) then\nerror \"it makes no sense to \+ apply commutative multiplication &* to non-commuting elements %1 and % 2\",a1,a2 \nend if;\n################################\nar1:=evalm(a1): ar2:=evalm(a2):\nif not type(a1,matrix) and type(ar1,matrix) then \n \+ _prolevel:=reset_prolevel: \n return procname(ar1,a2,tail ) \nend if;\nif not type(a2,matrix) and type(ar2,matrix) then \n \+ _prolevel:=reset_prolevel:\n return procname(a1,ar2,tail) \nend if;\n################################################################ ####################\n##If both inputs are of type clipolynom, climon, or clibasmon do the following:\n##################################### ###############################################\nif (type(evalm(a1),\{ clibasmon,climon,clipolynom\}) \n and \n type(evalm(a2),\{clibas mon,climon,clipolynom\}))\nthen \n if member(a3,\{Cliplus:-climul,c mul,cmulQ\}) then\n _prolevel:=reset_prolevel: \n return s implify(reorder(a3[lname](a1,a2)))\n elif \n member(a3,\{wedg e,qmul,omul\}) then\n _prolevel:=reset_prolevel:\n if _warni ngs_flag and nargs=4 then\n WARNING(sprintf(\"ignoring fourth \+ argument %a\",lname))\n end if; \n #return simplify(reor der(a3(a1,a2)))\n return eval('simplify'('reorder'(a3(a1,a2)))); \n else\n _prolevel:=reset_prolevel: \n return simplify( a3[lname](a1,a2)) \n end if;\nend if; \n########################### ################\n##If m1 is a polynomial and m2 is a matrix:\n####### ####################################\nif type(evalm(a1),\{clibasmon,cl imon,clipolynom,cliscalar\}) \n and \n type(a2,matrix)\n then \n if member(a3,\{qmul\}) then \n m2:=map(eval,a2) \n els e \n m2:=a2 \n end if;\n L:=map(displayid,convert(m2,'ml ist'));\n newL:=[]:\n for i from 1 to nops(L) do newL:=[op(newL),a 3[lname](a1,L[i])] end do;\n if not member(a3,\{qmul\}) then\n \+ _prolevel:=reset_prolevel: \n return map(displayid,map(simplify ,linalg[matrix](linalg[rowdim](a2),linalg[coldim](a2),newL)))\n else \n _prolevel:=reset_prolevel: \n return map(simplify,lina lg[matrix](linalg[rowdim](a2),linalg[coldim](a2),newL))\nend if:\nend \+ if: \n#######################################\n#a2 is a polynomial and a1 is a matrix\n#######################################\nif type(eval m(a2),\{clibasmon,climon,clipolynom,cliscalar\}) \nand \n type(a1,ma trix) \n then \n if member(a3,\{qmul\}) then \n m1:=map(e val,a1) \n else \n m1:=a1 \n end if;\n L:=map(displ ayid,convert(m1,'mlist'));\n newL:=[]:\nfor i from 1 to nops(L) do newL:=[op(newL),a3[lname](L[i],a2)] end do;\nif not member(a3,\{qmul \}) then\n _prolevel:=reset_prolevel:\n return map(simplify,linalg [matrix](linalg[rowdim](a1),linalg[coldim](a1),newL))\nelse\n _prole vel:=reset_prolevel: \n return map(simplify,linalg[matrix](linalg[ro wdim](a1),linalg[coldim](a1),newL))\nend if:\nend if: \n############## ########################################\n##If both inputs are of type matrix, do the following:\n########################################## ############\nif member(a3,\{qmul\}) then \n m1:=evalm(map(eval,a1)); m2:=evalm(map(eval,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \nend i f;\nm1:=displayid(m1):m2:=displayid(m2):\nr1:=linalg[rowdim](m1):r2:=l inalg[rowdim](m2):\nc1:=linalg[coldim](m1):c2:=linalg[coldim](m2):\nif c1 <> r2 then \n error \"matrices have incompatible dimensions and \+ cannot be multiplied\" \nend if;\nM:=linalg[matrix](r1,c2,[]);\nk:='k' :\nfor i from 1 to r1 do\nfor j from 1 to c2 do\nif a3=`&*` then \n \+ M[i,j]:=sum(m1[i,k] * m2[k,j],k=1..c1) \nelse \n M[i,j]:=map(simplif y,add(a3[lname](m1[i,k],m2[k,j]),k=1..c1)) \nend if;\nod end do;\n_pro level:=reset_prolevel:\nif member(a3,\{Cliplus:-climul,cmul,cmulQ,wedg e\}) then \n return subs(Id=1,map(reorder,map(simplify,evalm(M)))) e lse\n return subs(Id=1,map(simplify,evalm(M))) \nend if;\nif not mem ber(a3,\{`&*`,`&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omu l\}) then \n error \"third argument must be one of the following: cm ul, cmulQ, wedge, qmul, omul, &*, &r but received %1 instead\",a3 end \+ if;\nreturn ;\nend proc:" }}{PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " } {TEXT 343 5 "`&cm`" }{TEXT 344 333 " denotes multiplication of matrice s when Clifford product of Cl(B) is applied to matrix entries. One can use index as in &cm[K](p1,p2), &cm[-K](p1,p2), or &cm(p1,p2), &cm(M1, M2. However, when K has been assigned a matrix, put K between double q uotes as in &cm[''K''](p1,p2), &cm[''-K''](p1,p2).\n(Has been moved to Clifford:-setup).\n " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 273 8 "N o. 54: " }{TEXT 345 6 "`&cQm`" }{TEXT 346 416 " denotes multiplication of matrices when Clifford product of Cl(Q) is applied to matrix entri es. One can use index as in &cQm[K](p1,p2), or &cQm[-K](p1,p2) provide d index has not been assigned a matrix. If K has been assigned a matri x, put K between double quotes as in &cQm[''K''](p1,p2), or &cQm[''-K' '](p1,p2). Procedure can also be used withouht the index as in &cQm(p1 ,p2).\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 274 8 "No. 55: " }{TEXT 347 5 "`&wm`" }{TEXT 348 131 " denotes multiplication of matrices when wedge/exterior product i s applied to matrix entries:\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 262 8 "No. 56: " }{TEXT 349 5 "`&qm`" }{TEXT 350 127 " denotes multiplication of matrices when quaternion product i s applied to matrix entries:\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 275 8 "No. 57: " }{TEXT 351 5 "`&om`" }{TEXT 352 154 " denotes multiplication of matrices when non-associative octo nionic multiplication is applied to the matrix entries.\n(Has been mov ed to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 263 8 "No. 58: " } {TEXT 353 5 "`&rm`" }{TEXT 354 217 " denotes multiplication of matrice s when a generic associative but possibly not commutative `&r` product is applied to matrix entries. It can take index. User needs to define procedue `&r` in a similar mannet to `&c`." }{TEXT -1 1 "\n" }{TEXT 479 37 "(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously computed matrices of basis 1-vectors to find a m atrix representation in a minimal left or right ideal of any Clifford \+ polynomial in the given Clifford algebra Cl(Q). Depending on the sign ature [p,q] of the quadratic form Q, these matrices are " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 119 "real if (p - q ) mod 8 is 0, 1, 2; \ncomplex if (p - q) mod 8 is 3 or 7; \nquatern ionic if (p - q) mod 8 is 4, 5, or 6." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 311 "The real matrices of 1-vectors in dimensions from 2 to 8 have been computed with the procedure 'spinorK repr' in minimal left ideals and stored in a form of a table called 'm atrealL' in Maple library. The indices of the table are given by the s ignature [p,q]. To see matrices in a specific signature [p,q], enter" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">ma trealL([p,q]);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(assuming, of course, that the matrices for this signatur e are real)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 359 "Similarly for complex matrices in dimensions from 3 to 7 which are stored in the file 'matcompL.m' and for quaternionic matric es in dimensions from 2 to 8 which are stored in the file 'matquatL.m' .\n\nSimilarly for matrices representing basis 1-vectors in right mini mal ideals; in this case corresponding files are: 'matrealR.m', 'matco mpR.m', and 'matquatR.m'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 316 "Matrices representing Clifford polynomials a re generally computed with 'matKrepr' much faster than with 'spinorKre pr' because the former is a linear procedure that uses matrix multipli cation 'rmulm' to compute matrices representing basis monomials.\n\nNO TE: This procedure can now handle semi-simple Clifford algebras." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 13 "Typic al use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices representin g 1-vectors in a left minimal ideal for the current form B enter:" }} {PARA 258 "" 0 "" {TEXT -1 12 ">matKrepr();" }}{PARA 258 "" 0 "" {TEXT -1 4 " " }}{PARA 258 "" 0 "" {TEXT -1 103 "to find a matrix r epresenting a Clifford polynomial p for the current B in a left minima l ideal enter:\n" }}{PARA 258 "" 0 "" {TEXT -1 36 ">matKrepr(p); \n>ma tKrepr(p,'left');\n" }}{PARA 0 "" 0 "" {TEXT 256 313 "to find a matrix representing a Clifford polynomial p for the current B in a right min imal ideal enter:\n\n>matKrepr(p,'right');\n\nto see matrices represen ting 1-vectors in a minimal left or right ideal when Q has the signatu re [p,q], enter:\n\n>matKrepr([p,q]);\n>matKrepr([p,q],'left');\n\nor \n\n>matKrepr([p,q],'right');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4867 "matKrepr:=proc() \nlocal mindex,B size,dim,ind,pq,pqsig,matdata,i,a1,a2,dimrepr,ans,pqmod8,pqmod4,matdat atable,\n m,flag_simple,k,L,t,co,x,reprmulm;\nglobal B,matrealL,m atcompL,matquatL,matrealR,matcompR,matquatR:\noptions `Copyright (c) 1 995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: December 20, 2007`;\n################# ############################\n#Checking argument types\nif not member( nargs,\{0,1,2\}) then \n error \"wrong number of arguments: expects \+ 0, 1, or 2 argument(s)\" \nend if;\nif member(nargs,\{1,2\}) and not t ype(args[1],\{list,clibasmon,climon,clipolynom\}) then\n error \"fir st argument must be of type 'list', clibasmon, climon, or clipolynom b ut received one of type %1\",whattype(args[1]) \nend if;\nif nargs=2 \+ and not member(args[2],\{'left','right'\}) then \n error \"second ar gument, when used, must be 'left' or 'right', but received %1\",args[2 ] \nend if;\nif nargs<>0 then a1:=args[1] end if;\nif nargs=0 or type (a1,\{clibasmon,climon,clipolynom\}) then\n if not type(B,matrix) th en \n error \"matrix must be assigned to B\"\n elif not type( B,'diagmatrix') then\n error \"bilinear form B must be diagonal \"\n else \n pq:=Bsignature();\n pqmod8:=(pq[1]-pq[2]) \+ mod 8;\n pqmod4:=(pq[1]-pq[2]) mod 4;\n flag_simple:=evalb (pqmod4<>1);\n end if;\nelif type(a1,list) then pq:=a1:pqmod8:=(pq[ 1]-pq[2]) mod 8 \nelse error \"wrong argument(s)\"\nend if;\n######### #####################################\nif type(a1,\{clibasmon,climon,c lipolynom\}) then\n mindex:=maxindex(a1):Bsize:=linalg[coldim](B):\n if mindex > Bsize then\n error \"input error: maximum index in your input %1 is greater than the size %2 of the currently defined bi linear form B\",mindex,Bsize \n end if;\nend if;\nif nargs=1 or narg s=0 then a2:='left' else a2:=args[2] end if;\n#read in appropriate dat a file: \nif member(pqmod8,\{0,1,2\}) then\n if a2='left' then \n #if not assigned(matrealL) then readlib(matrealL) end if;\n \+ matdatatable:=matrealL:\n else\n #if not assigned (matrealR) then readlib(matrealR) end if;\n matdatatable:=mat realR:\n end if;\nelif member(pqmod8,\{3,7\}) then\n if a2=' left' then\n #if not assigned(matcompL) then readlib(matcompL) end if;\n matdatatable:=matcompL:\n else \n #if not assigned(matcompR) then readlib(matcompR) end if;\n matd atatable:=matcompR:\n end if;\nelif member(pqmod8, \{4,5,6\}) the n\n if a2='left' then\n #if not assigned(matquatL) then r eadlib(matquatL) end if;\n matdatatable:=matquatL:\n els e\n #if not assigned(matquatR) then readlib(matquatR) end if; \n matdatatable:=matquatR:\n end if; \n else error \"wron g value of pqmod8: %1\",pqmod8 \nend if;\n############################ ###########\npqsig:=map(op,[indices(matdatatable)]);\nif not member(pq ,pqsig) then\n error \"matrices for signature %1 in %2 minimal ideal have not been computed yet\",pq,a2 \nend if;\n###################### #################\nmatdata:=matdatatable[pq]:\nif nargs=0 or type(a1,l ist) then \n return matdata\nend if;\n#Continue if the first element is a polynomial\ndim:=linalg[coldim](B):dimrepr:=linalg[coldim](rhs(m atdata[1]));\nif dim<>nops(matdata) then \n error \"size of B is dif ferent from the number of 1-matrices\"\nend if;\n##################### ###################\nreprmulm:=proc() \n if nargs=1 then return args \n elif nargs=2 then return subs(Id=1,rmulm(args,`cmulQ`)) \n els e return subs(Id=1,reprmulm(args[1..(nargs-2)],rmulm(args[nargs-1],arg s[nargs],`cmulQ`))) \n end if;\nend proc:\n######################## ################\nm:=array(1..nops(matdata)):\nfor i from 1 to nops(ma tdata) do m[i]:=rhs(matdata[i]) end do;\nif type(a1,clibasmon) then\n \+ ind:=Clifford:-extract(a1,'integers'): \n if a1='Id' then \n \+ if flag_simple then \n return linalg[diag](1$dimrepr) \n \+ else \n return convert([linalg[diag](1$dimrepr)$2],'dfmatrix ') \n end if;\n end if; \n if nops(ind)=1 then ind:=op(ind) :\n return subs(Id=1,evalm(m[ind])) \n else return subs(Id=1, reprmulm(seq(evalm(m[ind[i]]),i=1..nops(ind)))) \n end if:\nend if; \n#########################################\nans:=clilinear(a1,'K'):\n if flag_simple then \n return subs(Id=1,evalm(eval(subs(K=procname,a ns)))) \nend if;\nans:=eval(subs(K=procname,ans));\nif type(ans,`+`) t hen ans:=[op(ans)] elif\n type(ans,`*`) then ans:=[ans] else\n err or \"unexpected type in matKrepr\" \nend if;\nL:=select(type,ans,matri x);\nans:=remove(type,ans,matrix);\nk:='k':x:='x':\nfor t in ans do\n \+ m:=ddfmatrix(op(select(type,[op(t)],matrix)));\n co:=mul(x,x=rem ove(type,[op(t)],matrix));\n L:=[op(L),convert([seq(evalm(co*m[k]), k=1..2)],'dfmatrix')]\nend do:\nif nops(L)=1 then return L[1] end if; \nans:=L[1]:\nfor k from 2 to nops(L) do\nans:=adfmatrix(ans,L[k]) end do:\nreturn evalm(ans);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 25 "No. 60. Sorting function " }{TEXT 376 7 "bygrade" }{TEXT -1 789 ": it sorts a list of Clifford basis monomials, Clifford monomials, or C lifford polynomials. Basis monomials and Clifford monomials are sorted by grade; in case of a tie it sorts by lexicographic order based on t he basis monomials. However, basis monomials are put before Clifford m onomials. If any of the elements is a Clifford polynomial, then ties a re resolved by sorting by the weight of each element (defined as the s um of the grades of all terms) and then by then number of Clifford bas is monomials in each expression. It returns true or false in each case , and can be used in sorting a list of basis monomials, Clifford monom ials, and Clifford polynomials in the construction sort(L, bygrade).\n \nUse: bygrade(p1,p2) where p1 and p2 are of type 'clibasmon', 'climon ', or 'clipolynom';\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1986 "bygrade: =proc(a1::\{clibasmon,climon,clipolynom\},\n a2::\{clibas mon,climon,clipolynom\}) \nlocal flag1,flag2,flag11,flag22,p1,p2,n1,n2 ,c1,c2,x,w1,w2;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2007`;\n############################################# \nif type(a1,clibasmon) then p1:=a1;\n flag1 :=true:\n flag11:=true:\n \+ n1:=Clifford:-extract(p1): \n elif type(a1,climon) then p1: =op(cliterms(a1));\n flag1:=true:\n \+ flag11:=false:\n n1:=Cliff ord:-extract(p1): \n else p1:=a1;\n flag1:=false:\nend if;\ni f type(a2,clibasmon) then p2:=a2;\n flag2:=t rue:\n flag22:=true:\n \+ n2:=Clifford:-extract(p2): \n elif type(a2,climon) then p2:=op (cliterms(a2));\n flag2:=true:\n \+ flag22:=false:\n n2:=Clifford :-extract(p2): \n else p2:=a2;\n flag2:=false:\nend if;\nx:=' x':\nif flag1 and flag2 then\n if nops(n1)nops(n2) then return false\n else \n if eval b(flag11 and flag22) then return lexorder(p1,p2)\n elif evalb( flag11 and not flag22) then return lexorder(p1,p2)\n elif eval b(not flag11 and flag22) then return not lexorder(p2,p1);\n el se return true\n end if;\n end if; \nelse \n n1:=maxgrade(p 1):\n c1:=cliterms(p1):\n w1:=add(maxgrade(x),x=c1):\n n2:=maxgr ade(p2):\n c2:=cliterms(p2):\n w2:=add(maxgrade(x),x=c2):\n if n 1=n2 then\n if w1=w2 then \n if nops(c1)<=nops(c2) then r eturn true else return false end if;\n else if w1 " 0 "" {MPLTEXT 1 0 2122 "commuting elements:=proc(a1::list(clibasmon)) \nlocal g,groupgens,L,L2,numfact,f ,flag1,flag2,flag3,gen,p,q,i;\nglobal B;\noptions `Copyright (c) 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\nif not type(B,matrix) then \n error \"mat rix must be assigned to B\"\nend if;\nif not type(B,'diagmatrix') then \n error \"the bilinear form B is not diagonal as expected\" \nend \+ if;\np:=Bsignature(B)[1]:q:=Bsignature(B)[2]:\nnumfact:=q-RHnumber(q-p ):\nflag1:=member(Id,a1):\nL:=remove(member,a1,[Id]):\n#return a1 if i t was [Id]\nif L=[] then return args end if; \n#return a1 if had one e lement of square 1 or [] if the square <>1 \nif nops(L)=1 then\n if \+ cmul(L[1],L[1])=Id then return L\n else return [] \nend if;\nend \+ if;\n#First, sort the list\nL:=sort(L,bygrade):\n#Find first element o f square 1 mod Id\nflag2:=false:L2:=[]:groupgens:=[]:\nfor g in L whil e not flag2 do \n if evalb(cmul(g,g)=Id) then groupgens:=[g];flag2: =true\n else L2:=[op(L2),g] fi end do:\nL:=remove(member,L,[op(L2), op(groupgens)]);\nif L=[] then \n if flag1 then \n return [Id] \+ else return groupgens \n end if;\nend if; \nif nops(groupgens)=numfa ct then \n return (sort(groupgens,bygrade)) end if;\n#Find commuting elements with square 1 mod Id in the specified list of basis monomial s\nfor g in L while nops(groupgens)0)) \n then group gens:=[op(groupgens),g] \n end if;\nend if:\nend do:\nif groupgen s=[] then return args else return sort(groupgens,bygrade) end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 62. Procedure " } {TEXT 378 16 "factoridempotent" }{TEXT -1 369 " can factor the given i dempotent e into a product of N elements of the type (1/2)*(Id+e[i]), \+ i=1..N, where \{e[i],i=1..N\} is a set of commuting basis monomials w ith square 1 mod Id in the standard (canonical) basis of Cl(Q). It is known that when N = q - RHnumber(q-p) then e is primitive. \n\nTypic al use: factoridempotent(f); #here f is expected to be an idempotent \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1737 "factoridempotent:=proc(a1:: idempotent) \nlocal T,ee,i,L,flag,flag1,flag2,b1b2,b1,b2,ans;\nglobal \+ B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\nif a1=Id the n return Id end if;\nif not type(B,matrix) then \n error \"matrix mu st be assigned to B\"\nend if;\nif not type(B,'diagmatrix') then \n \+ error \"the bilinear form B is not diagonal as expected\" \nend if;\ne e:=eval(a1):\nL:=sort(remove(member,convert(cliterms(ee),list),[Id]),b ygrade):\nif nops(L)=1 then \n ans:=(1/2)*(Id+L[1]);\n if displayi d(a1-ans)=0 then return ans else return a1 end if;\nend if;\nflag1:=tr ue:\nwhile flag1 do\nflag2:=true:\nL:=sort(L,bygrade);\nfor b1 in L wh ile flag2 do\nfor b2 in remove(member,L,[b1]) while flag2 do\n b1b2 :=cmulQ(b1,b2):\n if member(b1b2,L) then flag2:=false;\n \+ L:=remove(member,L,[b1b2]) end if;\n if member(-b1b 2,L) then flag2:=false;\n L:=remove(member,L ,[-b1b2]) end if;\n if flag2 then flag1:=false end if;\nod od end d o: \nL:=commutingelements(L);\nif nops(L)=1 then \n ans:=(1/2)*(Id+L [1]);\n if displayid(a1-ans)=0 then return ans else return a1 end if ;\nend if;\nL:=sort(L,bygrade);\ni:='i':\nans:='cmulQ'(seq((1/2)*(Id+L [i]),i=1..nops(L)));\nif eval(ans)-a1=0 then return (ans) end if;\n#tr y another sign permutation\nfor i from 1 to nops(L) do\n L||i:=[L[i ],-L[i]]\nend do:\nT:=combinat[cartprod]([seq(L||i,i=1..nops(L))]):\nf lag:=false:\nwhile not T[finished] and not flag do \nL:=T[nextvalue]() ;\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\nif eval(ans)-a1=0 then flag:=true:return ans end if;\nend do:\n#return unfactored\nretu rn a1;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 63. Procedu re " }{TEXT 379 11 "makealiases" }{TEXT -1 996 " allows the user to al ias basis monomials in a Clifford algebra Cl(V), e.g., to alias e1we2 \+ as e12, or e2we1 as e21. The procedure accepts a positive integer p>1 \+ where p denotes the dimension of the vector space V. A practical limi tation on p is of course the amount of memory Maple will allocate to s tore these aliases since every basis monomial, not necessarily written in the standard order, will be aliased. This procedure is intended t o be used when p < 5 although it can be used also when p < 10. Rememb er that to unalias e12 one needs to either restart Maple or simply ass ign e12:='e12'.\n\nAs a memory saving feature, option 'ordered' (or \" ordered\") may be entered as a second parameter. If the second paramet er is used, aliases are created only for monomials with ordered indice s, for example, e12 will be an alias for e1we2.\n\nThe procedure retur ns a list of aliases to be defined so they can bee seen by the user. \+ In order to finish the definition process, use 'eval' as shown below. \n" }}{PARA 258 "" 0 "" {TEXT -1 139 "Once basis elements have been al iased, Clifford multiplication can be done using these aliases.\n\nTyp ical use: \n\n>makealiases(3);\n>eval(%);\n" }}{PARA 258 "" 0 "" {TEXT -1 41 "or\n\n>makealiases(3,'ordered');\n>eval(%);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 803 "makealiases:=proc(a1::posint,a2::\{symbol, string\}) \nlocal L,i,k,l,K,s;\noptions `Copyright (c) 1995-2008 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\n description `Last revised: December 20, 2007`;\n###################### #######################\nif not a1>1 then \n error \"first parameter must be a positive integer larger than one\" \nend if;\nif nargs=2 an d not member(a2,\{'ordered',\"ordered\"\}) then\n error \"second opt ional parameter, when used, must be 'ordered'\" \nend if;\nk:='k':l:=' l':i:='i':\nL:=[seq(op(combinat[choose]([seq(i,i=1..a1)],k)),k=2..a1)] ;\nif nargs=1 then \n K:=[seq(op(combinat[permute](l)),l=L)];\n s: =seq(cat(e,op(K[i]))=makeclibasmon(K[i]),i=1..nops(K))\nelse\n s:=se q(cat(e,op(L[i]))=makeclibasmon(L[i]),i=1..nops(L))\nend if;\nreturn ' alias'(s)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 64. Proce dure " }{TEXT 380 4 "cinv" }{TEXT -1 1285 " calculates a symbolic inve rse of any Clifford polynomial p in the given Clifford algebra Cl(B) o r in its subalgebra. The procedure determines a basis for the smalles t subalgebra of Cl(B) in which the inverse might exist. For example, \+ if the polynomial p contains only even grades, then the inverse is sou ght in an even subalgebra of Cl(B); otherwise, the inverse is sought i n a Clifford algebra over a vector space V whose dimension equals tha \+ maximum index in p. \n\nIf the bilinear form B is not assigned then e very Clifford polynomial in Cl(B) has a symbolic inverse. If the bilin ear form B is assigned then not every element in Cl(B) has the inverse . For example, nilpotent and non-trivial idempotent elements have no \+ inverses. Elements p such that p &c p = a*p for some 'cliscalar' als o have no inverses (these elements are called here 'almost idempotent' ).\n\nThus, if B is assigned and the inverse does not exist, the proce dure tries to identify if p is one of the above types and if so, it re turns an appropriate error message. Otherwise it returns 'NULL'.\n\nT his procedure can be used with a second optional argument K of type sy mbol, name, matrix , or array. In that case, it computes the inverse i n Cl(K). The seconf argument can also be -K, or any numeric multiple o f K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Typical use: cinv(e1 + 2*e2);cinv(e1 + 2*e2,K); cinv(e1 + 2*e2,-K) ; \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4200 "cinv:=proc(a1::\{cliscal ar,clibasmon,climon,clipolynom\}) \nlocal p,pp,pinv,mindex,cinv11,s,aa a,flagB,flagBdiag,S,lname,flagindexed;\nglobal B,_warnings_flag;\nopti ons `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007` ;\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 lname:=ar gs[2];\n flagindexed:=true:\nelse error \"only one or two arguments are expected\"\nend if;\n############################\ncinv11:=proc(a 1,lname)\nlocal i,d,dbasis,N,u,xm,v,uv,vu,vars,sys,L1,v1,nontrivial;\n global evenelement;\n nontrivial:=proc(S::\{set(\{relation,algebraic \}),list(\{relation,algebraic\})\}) \n local istrivial; \n istrivial:=proc(x) \n if typ e(x,relation) then evalb(x) else evalb(x=0) end if; \n e nd proc;\n remove(istrivial,S)\n end proc: \ni:='i':\nd:=maxindex(a1):\nif type(a1,'evenelement') then dbasis:=c basis(d,'even')\n else dbasis:=cbasis(d) \nen d if:\nN:=nops(dbasis):\nu:=clicollect(reorder(a1)):\nxm:=array(1..N): \nv:=sum(xm[i]*dbasis[i],'i'=1..N);\nuv:=collect(cmul[lname](u,v)-Id,d basis);\nvu:=collect(cmul[lname](v,u)-Id,dbasis);\nvars:=\{coeffs(v,db asis)\};\nsys:=\{coeffs(uv,dbasis),coeffs(vu,dbasis)\};\nsys:=nontrivi al(sys); #eliminate trivial equations\nL1:=solve(sys,vars);\nif L1=NUL L then return (NULL) else \nv1:=subs(L1,v);\nv1:=reorder(v1):\nv1:=cli collect(v1):\nv1:=map(normal,v1);\nreturn (eval(v1)): \nend if;\nend p roc:\n#####################################\nif type(a1,cliscalar) the n\n if a1<>0 then return 1/a1 else error \"0 has no inverse\" end if ;\nend if;\nmindex:=maxindex(a1);\nif mindex=0 then return Id/scalarpa rt(a1) end if;\np:=simplify(reorder(a1)):\np:=displayid(p):\npinv:=cin v11(p,lname);\nif evalb(pinv<>NULL) then return pinv end if; \n####### ##############################\nflagB:=type(evalm(lname),matrix):\nif \+ not flagB then return \"unable to find inverse of %1\",a1 end if;\n### ##################################\nif _warnings_flag then\n WARNING (`testing why entered argument has no inverse...`)\nend if;\n#Checking these special cases only when lname is assigned a matrix:\ns:='s':aaa :='aaa':\nflagBdiag:=type(evalm(lname),diagmatrix):\n################# ######################\n###Checking if element a1 is nilpotent\n###### #################################\nif type([p,lname],nilpotent) then\n if flagBdiag then \n error \"element %1 is nilpotent in signat ure %2 and as such it has no inverse\",a1,Bsignature(lname) \n else \n error \"element %1 is nilpotent in current %2 and as such it h as no inverse\",a1,lname \n end if;\nend if;\n###################### #################\n###Checking if element a1 is idempotent\n########## #############################\nif not member(p,\{Id\}) and type([p,lna me],idempotent) then\n if flagBdiag then \nerror \"element %1 is an \+ idempotent in signature %2 and as such it has no inverse\",a1,Bsignatu re(lname)\n else \nerror \"element %1 is an idempotent in current %2 and as such it has no inverse\",a1,lname\n end if;\nend if;\n###### #################################\n###Checking if a1 is almost idempot ent\n####################################### \npp:=cmul[lname](p,p):\n if match(pp=aaa*p,cliterms(p),'s') then \n if flagBdiag then \n er ror \"element 'p'=%1 is almost an idempotent since %2 and as such it h as no inverse in signature %3\", a1,subs(s,'cmul'('p','p')=aaa*'p'),Bs ignature(lname)\n else \n error \"element 'p'=%1 is almost an idem potent since %2 and as such it has no inverse in current %3\", a1,subs (s,'cmul'('p','p')=aaa*'p'),lname\n end if;\nend if;\n############## #########################\nS:=\{solve(pp-s*p,s)\}:\nif not evalb(S=\{ \}) then \n if flagBdiag then \n error \"element 'p'=%1 is almost \+ an idempotent since %2 and as such it has no inverse in signature %3\" , a1,subs(aaa=op(S),'cmul'('p','p')=aaa*'p'),Bsignature(lname)\n els e \n error \"element 'p'=%1 is almost an idempotent since %2 and as \+ such it has no inverse in current\", a1,subs(aaa=op(S),'cmul'('p','p') =aaa*'p'),lname\n end if;\nend if;\nreturn NULL\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 65. Procedure " }{TEXT 381 9 "pseud odet" }{TEXT -1 87 " computes pseudodeterminant of a 2 x 2 matrix with entries in a Clifford algebra Cl(B)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typical use: M := linalg[matrix](2 , 2, [Id, e1 + e2, e3, e4we3]); " }}{PARA 258 "" 0 "" {TEXT -1 37 " \+ pseudodet(M);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 533 "pseudodet:=proc(a1::\{climatrix, matrix\}) local M,a,b,c,d;\noptions `Copyright (c) 1995-2008 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2007`;\n################################### ##########\nM:=map(displayid,evalm(a1)):\nif linalg[rowdim](M) <> 2 or linalg[coldim](M) <> 2 then \n error \"matrix must be 2 x 2\" \nend if;\na:=simplify(M[1,1]): b:=simplify(M[1,2]):\nc:=simplify(M[2,1]): d:=simplify(M[2,2]):\nreturn simplify(cmul(a,reversion(d)) - cmul(b, reversion(c)))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 45 "No. 66. \+ Defining quaternionic mutliplication " }{TEXT 382 4 "qmul" }{TEXT -1 687 ". Quaternions are defined as the even elements in Cl(3) (or the \+ para-bivectors in Cl(3)). Thus, a quaternion basis is [Id, e3we2,e1we3 ,e2we1] and it is available as the first component of global variable \+ '_quatbasis' defined at the initialization time (type _quatbasis or _q uatbasis[1] at the Maple prompt to see it). See P. Lounesto, \"Cliffo rd Algebras and Spinors\", page 49, for more information on quaternion s. Any element that belongs to this vector space is now of type 'quat ernion'. The infix form of this multiplication is `&q`. Via the proc edure 'rmulm', the quaternionic multiplication may also be applied to \+ matrices with quaternionic entries and is then denoted by `&qm`." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 121 "NOTE : in order to see answers displayed in terms of the basis \{Id, qi, qj , qk\}, apply 'qdisplay' to the result of 'qmul'." }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 "Typical use: qmul(I d + e1we2, e1we3); or (Id + 2*e1we2) &q (e2we3 + e1we2); or (Id + qi) \+ &q (qj + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1299 "qmul:=proc() \+ local q1,q2,q3,step1,repqmul; \n global B,qi,qj,qk ,_default_Clifford_product;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: December 20, 2007`;\n################################## ###########\nif member(0,[args]) then return 0 end if;\nif nargs=1 the n return qdisplay(args) end if;\n repqmul:=proc() \n if nargs=1 \+ then return args elif\n nargs=2 then return 'qmul'(args) else\n return repqmul(args[1..(nargs-2)],'qmul'(args[nargs-1],args[na rgs])) \n end if;\n end proc:\nif nargs>2 then \n q3:=eval(rep qmul(args)):\n return qdisplay(map(combine,q3,trig)) \nend if;\n_def ault_Clifford_product:='cmulNUM':\nq1:=eval(args[1]):q2:=eval(args[2]) :\nif type(q1,`^`) or type(q2,`^`) then \n error \"illegal expressio n found: use 'qinv' for the quaternionic inverse\" \nend if;\nif type( q1,cliscalar) or type(q2,cliscalar) then \n return qdisplay(q1*q2) \+ \nend if;\nif q1=Id then return qdisplay(q2) end if;\nif q2=Id then re turn qdisplay(q1) end if;\nif not type(q1,quaternion) or not type(q2,q uaternion) then\n error \"wrong input type: input must be of type 'c liscalar' or 'quaternion'\" \nend if;\nstep1:=reorder(cmul(q1,q2));\nr eturn qdisplay(map(combine,clicollect(step1),trig))\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 375 23 "No. 67. Ampersand form " }{TEXT 383 4 "` &q`" }{TEXT 384 4 " of " }{TEXT 385 4 "qmul" }{TEXT 386 39 ".\n(Has be en moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 42 "No. \+ 68. Defining quaternionic conjugation " }{TEXT 387 8 "q_conjug" } {TEXT -1 112 ". Recall that complex conjugation was named 'c_conjug' \+ while the Clifford conjugation was just 'conjugation'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typical use: q_ conjug(Id + 2*e1we2); or q_conjug(Id + 2*qi + qk); \n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 558 "q_conjug:=proc(q::algebraic) local q1; global qi,qj,qk;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2007`;\n#############################################\nif t ype(q,matrix) then return map(procname,q) elif\n type(q,\{cliscalar, quaternion\}) then\nq1:=eval(q):\nif type(q1,cliscalar) then return q1 \nelse\n return qdisplay(2*scalarpart(q1)-q1)\nend if;\nelse\n e rror \"wrong input types: input must be of type 'cliscalar', 'quaterni on', or 'matrix' \" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 69. Quaternionic norm " }{TEXT 388 5 "qnorm" }{TEXT -1 24 " is defined as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 65 " Typical use: qnorm(Id + 2*e1we2); or qnorm(I d + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 447 "qnorm:=proc(q::\{cliscalar,quaternion\}) local \+ q1,n,co; global qi,qj,qk;\noptions `Copyright (c) 1995-2008 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2007`;\n#################################### #########\nq1:=expand(eval(q));\nif type(q1,cliscalar) then return abs (q1) \nelse\n n:=0:for co in [coeffs(q1,cliterms(q1))] do n:=n+co^2 \+ end do;\n return combine(sqrt(n),trig) \nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 38 "No. 70. Quaternionic inverse is named \+ " }{TEXT 389 4 "qinv" }{TEXT -1 141 ". Recall that the inverse of a C lifford polynomial can be calculated with 'cinv' and that quaternions \+ form a noncommutative division ring. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "Typical use: qinv(Id + 2*e1we2); or qinv(Id + 2*qi + 3*qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 457 "qinv:=proc(q::\{cliscalar,quaterni on\}) local q1,q2; \noptions `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2007`;\n########################################## ###\nq1:=eval(q):\nif q1=0 then error \"zero quaternion has no inverse \"\nelif type(q1,cliscalar) and q1<>0 then return 1/q1\nelse q2:=q_con jug(q1)/(qnorm(q1))^2:\n return qdisplay(map(combine,q2,trig))\nen d if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 71. Procedure " }{TEXT 390 8 "qdisplay" }{TEXT -1 101 " displays quaternions or mat rices with quaternionic entries in terms of the basis \{Id, qi, qj, qk \}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*Id); map(qdisplay, matrix(2, 2, [I d, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 723 "qdisplay:=proc(a1::\{algebraic,array\}) local q; glo bal qi,qj,qk;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\ni f type(a1,matrix) then\n if not type(a1,climatrix) then \n retu rn evalm(a1) else \n return map(qdisplay,a1) \n end if;\nend if ;\nq:=eval(simplify(a1)):\nif type(q,cliscalar) then return q end if; \nif type(q,quaternion) then\nq:=map(combine,clicollect(reorder(q)),tr ig);\nreturn coeff(q,Id)-coeff(q,e1we2)*'qk'+coeff(q,e1we3)*'qj'-coeff (q,e2we3)*'qi'\nelse \nerror \"wrong input type: input must be of type 'cliscalar', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Procedure " }{TEXT 391 5 "rot3d " }{TEXT -1 161 " rotates a vector in 3-dimensional Euclidean space V \+ using the quaternion multiplication. Namely, any vector v is transfo rmed according to the following law: " }}{PARA 258 "" 0 "" {TEXT -1 1 " " }}{PARA 258 "" 0 "" {TEXT -1 84 " \+ v -> q &c v &c qinv(q) " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 459 "where q is a quat ernion given in the basis [Id, e1we2, e1we3, e2we3]. The first entry s hould be a vector (or any element of the Clifford algebra) while the s econd element is a quaternion. Type '_quatbasis' to see how quaternio ns are defined here. Elements 'qi', 'qj', 'qk' are defined at the tim e of initialization and denote the pure-quaternion basis elements. It is assumed that the user has defined a bilinear form B as the 3 x 3 i dentify matrix as in:\n" }}{PARA 258 "" 0 "" {TEXT -1 28 " >B := linal g[diag](1$3); \n" }}{PARA 258 "" 0 "" {TEXT -1 108 "before using 'rot 3d'. Of course, 'rot3d' will also work if the first argument were any element in Cl(3). \n" }}{PARA 258 "" 0 "" {TEXT -1 296 "NOTE: tradit ionally one uses \{1, i, j, k\} to denote a quaternion basis. Here, w e are using symbol 'qi' for 'i', 'qj' for 'j', and 'qk' for 'k'. Symb ol 'Id' denotes, as usual, the unit element in all Clifford algebras a s well as the unit element in reals, complexes, quaternions, and octon ions. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 55 "Typical use: rot3d(e1 + e2, Id + 2*qi - 3*qj + 2*qk); " }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 857 "ro t3d:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::quaternion) \nlocal q2,q2inv; global B,qi,qj,qk; \noptions `Copyri ght (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n######## #####################################\nif not assigned(B) or not type( B,matrix) then \n error \"bilinear form B has not been assigned yet. It must be defined as the identity 3 x 3 matrix.\"\nend if:\nif not l inalg[equal](B,linalg[diag](1$3)) then \n error \"the identity 3 x 3 matrix must be assigned to B\" \nend if;\nif nargs <> 2 then \n err or \"two arguments needed of type algebraic and quaternion\" \nend if; \nq2:=clisort(map(combine,eval(a2),trig)); \nq2inv:=clisort(map(combi ne,eval(qinv(eval(q2))),trig)); \nreturn clicollect(clisort(map(combin e,cmulQ(q2,a1,q2inv),trig))) \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 73. Procedure " }{TEXT 392 9 "isproduct" }{TEXT -1 238 " ca n determine whether the given Clifford polynomial, e.g. p := Id + 4*e 1we2 + e3we4, is a product of 1-vectors in the given Clifford algebra. It can be used with two options `all`, or `any`, or can be used witho ut any option as follows:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 "Typical use:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "isproduct(p); answers \+ true or false;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "isproduct(p, 'any'); answers true or false, and gives a list of n vectors [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 161 "isproduct(p, 'all'); answers true or fals e, and gives a list of general vectors [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;\n\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 4895 "isproduct:=proc(p::\{cliscalar,clibasmon,climon,c lipolynom\},\n s::\{string,symbol\}) \nlocal M,maxg,T,c o,vv,x,cf,pnew,p1,L,v,j,S,S2,i,v1v2,expr,t,sys,\nvars,sol,ventries,fla g,flagB,flagtB,param,flagsol,eq,P1,P2,die,parvalues;\nglobal _MaxSols, B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\nif not membe r(nargs,\{1,2\}) then\n error \"one or two arguments needed of type 'c liscalar', 'clibasmon', 'climon', 'clipolynom', and 'symbol'\"\nend if ;\nif nargs=2 and not member(s,\{'all','any'\}) then\n error \"secon d (optional) argument must be 'all' or 'any'\"\nend if;\nif not type(B ,diagmatrix) then \n error \"diagonal matrix must be assigned to B\" end if;\nmaxg:=maxgrade(p);\n######################################## #############\n#An element of grade 0 is always factorable in Cl(B):\n #####################################################\nif maxg=0 then \+ \n if nargs=1 then return true end if;\n flag:=false:\n for i fr om 1 to linalg[coldim](B) while not flag do\n if B[i,i]<>0 then \+ flag:=true;\n return [true,[(scalarpart(p)/B[i,i])*e||i,e||i] ] \n end if;\n end do;\nerror \"none of the basis 1-vectors ha s a square equal to 1 or -1\" \nend if;\n############################# ########################\n#Any 1-vector is already factored:\n######## #############################################\nif vectorpart(p,1)-p=0 \+ then \n if nargs=1 then return true\n else return [true ,[p]] \n end if;\nend if;\n######################################### ############\n#Any basis monomial is already factored:\n############## #######################################\nflagB:=type(B,diagmatrix):\np 1:=factor(reorder(displayid(p))):\nflagtB:=evalb(type(p1,\{clibasmon,c limon\}) and flagB):\nif flagtB then \n S:=op(Clifford:-extract(p 1,'integers'));\n if nargs=1 then return true else \n v:=[e| |S];\n if not remove(hastype,p1,clibasmon)=NULL\n then v [1]:=remove(hastype,p1,clibasmon)*v[1] \n end if;\n return [ true,v] \n end if; \nend if;\n################################# ########################\n#If p does not belong to any of the special \+ cases above,\n#find common indices to all monomial terms in p, if any, \n#and then simplify p by factoring out the common factors:\n######### ################################################\nT:=cliterms(p):\nco: =`intersect`(op(map(convert,map(Clifford:-extract,T,'integers'),set))) ;\nx:='x':\nif nops(co)<>0 then\n co:=sort(convert(co,list));\n vv :=[seq(cat(e,x),x=co)];\n cf:=cmul(op(vv));\n pnew:=cmul(p,cf,cf,c f);\n if nargs=1 then M:=procname(pnew) \n elif\n nargs=2 \+ then L:=procname(pnew,s);\n M:=[L[1],[op(L[2]),op(vv )]]; \n end if;\n return M\nend if; \n########################### ##########################\n#This is the most general case when no com mon indices\n#in monomial terms are found:\n########################## ###########################\nS2:=map(Clifford:-extract,cliterms(p),'in tegers');\nS:=\{op(map(op,S2))\}; \nv:=table([]):\nfor j from 1 to max g do\nv[j]:=0:\nfor i in S do v[j]:=v[j]+cat(x,j,i)*cat(e,i) \nend do; \nend do;\nv1v2:=cmul(seq(v[j],j=1..maxg));\nexpr:=clicollect(simplify (reorder(p-v1v2))):\nt:=cliterms(expr);sys:=\{\}:\nfor i from 1 to nop s(t) do sys:=\{op(sys),coeff(expr,op(i,t))=0\} end do:\nvars:=sort([op (indets(sys))],lexorder); \n_MaxSols:=1: #setting maximum number of \+ solutions to one\nvars:=convert(vars,set):\nsol:=[solve(sys,vars)]:\ni f nops(sol)=0 then return false end if;\nventries:=[seq(v[j],j=1..maxg )];\n#######################################################\n#Finally , we need to return result in appropriate form.\n#By now, if p were no t factorable, 'false' should have\n#been returned:\n################## #####################################\nif nargs=1 then return true end if; \nif nargs=2 and s='all' then return [true,subs(sol[1],ventries)] end if; \n#########################################################\n #If the second parameter is 'any', assign random values\n#to the param eters showing up in the answer. These random\n#values will change with each execution of the program:\n##################################### ####################\nif nargs=2 and s='any' then \nparam:=proc(a1::\{ `=`\}) \n if lhs(a1)=rhs(a1) or rhs(a1)=0 then true else false end i f;\nend proc:\nflagsol:=false:\nfor i from 1 to 2 while not flagsol do \nS2:=\{\}:P1:=\{\}:P2:=\{\}:\nS2:=\{op(sol[1])\};\nparvalues:=[1,-1,1 /2,-1/2,1/3,-1/3];\ndie := rand(1..6):\nfor eq in select(param,S2) do \+ \n if rhs(eq)=0 then P1:=P1 union \{eq\}\n else P1:=P1 \+ union \{lhs(eq)=parvalues[die()]\};\n end if;\nend do;\nP2:=remove(pa ram,S2):\nL:=map(op,subs(P2,ventries));\nif not member(0,subs(P1,map(d enom,L))) then flagsol:=true end if;\nend do:\nif flagsol then return \+ [true,subs(P1,subs(P2,ventries))]\n else return [true,subs(s ol[1],ventries)]\nend if;\nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 74. Procedure " } {TEXT 393 14 "isVahlenmatrix" }{TEXT -1 258 " determines if the given \+ 2 x 2 matrix is Vahlen matrix as defined in P. Lounesto, \"Clical and \+ counter-examples\", in eds. R. Ablamowicz, P. Lounesto, and J. Parra, `Clifford algebras with symbolic and numeric computations`, Birkhause r, Boston, 1996, page 19." }}{PARA 258 "" 0 "" {TEXT -1 349 "\nVahlen \+ matrix V is a 2 x 2 matrix with entries in a Clifford algebra Cl(p, q) such that if \n\n V := matrix(2, 2, [a, b, c, d]); \+ \+ \nand a,b,c,d are \+ elements in Cl(p, q), then the following conditions must be met:" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "1. a, b, c, d are products of vectors;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 74 "2. the pseudodeterminant of V is +1 o r -1 (or Id or -Id in the algebra);" }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 98 "3. a &c reversion(b), reversion(b) \+ &c d, d &c reversion(c), and reversion(c) &c a are all vectors." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 31 "Typic al use: isVahlenmatrix(V);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 120 "V := matrix(2, 2, [Id - e1we4, -e1 + e4, e1 \+ + e4, Id + e1we4]) (this example of Vahlen matrix is due to Johannes \+ Maks)." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1213 "isVahlenmatrix:=proc(cm::\{matrix,climatrix\}) \nlocal expr1 ,expr2,a,b,c,d,m; global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: December 20, 2007`;\n################################## ###########\nif not type(B,matrix) then \n error \"square matrix mus t be assigned to B\" \nend if;\nif linalg[rowdim](cm)<>2 or linalg[col dim](cm)<>2 then \n error \"to calculate pseudodeterminant matrix mu st be 2 x 2\" \nend if;\nm:=displayid(cm):\na:=simplify(m[1,1]):b:=sim plify(m[1,2]):\nc:=simplify(m[2,1]):d:=simplify(m[2,2]):\n############ ##############################\n### Condition 1:\n#################### ######################\nif a<>0 then if not isproduct(a) then return f alse fi end if;\nif b<>0 then if not isproduct(b) then return false fi end if;\nif c<>0 then if not isproduct(c) then return false fi end if ;\nif d<>0 then if not isproduct(d) then return false fi end if;\n#### ######################################\n### Condition 2:\n############ ##############################\nif not member(pseudodet(m),\{1,-1,Id,- Id\}) then return false end if;\n##################################### #####\n### Condition 3:\n##########################################\n " }{TEXT 359 0 "" }{MPLTEXT 1 0 585 "expr1:=simplify(cmul(a,reversion( b)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(ex pr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(reversio n(b),d));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplif y(expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(d,re version(c)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(sim plify(expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul( reversion(c),a));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb (simplify(expr1-expr2)=0) then return false end if;\nreturn true\nend \+ proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 75. Procedure " }{TEXT 394 10 "climinpoly" } {TEXT -1 407 " finds the minimal polynomial of any Clifford polynomial p. It may be used with an optional second argument 'powers' in which \+ case it returns a list of consecutive powers p^k of p which are linear ly independent, k=1..(n-1) where n = degree of the minimal polynomial \+ of p. If the second optional argument is 'horner' then polynomial is r eturned in 'horner' form. This procedure can accept now optional index ." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 83 " Typical use: climinpoly(p);climinpoly[K](p);\n clim inpoly(p,'s');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1407 "climinpoly:=proc(p::\{cliscalar,clibasmon,climon,cl ipolynom\})\nlocal dp,L,flag,pp,expr,a,k,eq,sys,vars,sol,poly,lname;\n options `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: December 20, 2 007`;\n#############################################\nif type(op(procn ame),procedure) then\n lname:=`B`;\n else\n lname:=op(procname) ;\nend if;\ndp:=displayid(p):\nif maxgrade(dp)=0 then L:=[Id] else L:= [Id,dp] end if;\nflag:=false:k:='k':a:='a':\nwhile not flag do\npp:=cm ul[lname](L[nops(L)],dp):\nexpr:=expand(add(a[k]*L[k],k=1..nops(L))); \neq:=clicollect(pp-expr);\nsys:=\{coeffs(eq,cliterms(eq))\};\nvars:= \{seq(a[k],k=1..nops(L))\};\nsol:=solve(sys,vars):\nif sol<>NULL then \+ flag:=true else L:=[op(L),pp] end if;\nend do;\npoly:='x'^nops(L)-add( a[k]*'x'^(k-1),k=1..nops(L));\npoly:=sort(subs(sol,poly)); \nif nargs= 1 then return poly\nelif nargs=2 then\n if args[2]='powers' then r eturn [poly,L]\n elif args[2]='horner' then return convert(poly, horner)\n else error \"second (optional) argument must be 'power s' or 'horner' \"\n end if;\nelif nargs=3 then\n if member(arg s[2],\{'powers','horner'\}) and\n member(args[3],\{'powers','ho rner'\}) then\n return ([convert(poly,horner),L])\n e lse error \"wrong arguments\"\n end if;\nelse error \"wrong number of arguments: one, two, or three arguments are needed only\"\nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 76. Procedure " } {TEXT 395 15 "subs_climinpoly" }{TEXT -1 283 " substitutes any Cliffor d polynomial p into any polynomial pol in one variable. It may be used with an optional third argument in which case it returns unevaluated \+ polynomial pol in 'horner' form. For example, one can use this procedu re to verify that the given Clifford polynomial p" }{TEXT 356 1 " " } {TEXT -1 37 "satisfies its own minimal polynomial." }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 197 "Typical use: subs_cl iminpoly(p,pol);\n subs_climinpoly(p,pol, 'horner') ;\n subs_climinpoly(p,pol, \"horner\");\n \+ subs_climinpoly(p,pol, horner);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1333 "subs_clipolynom:=proc(clinumber::\{symbol,cliscalar ,clibasmon,climon,clipolynom\},\n minpoly::poly nom,o::\{symbol,string\}) \nlocal ph,d,k,r,q,h,expr,s,var,varx,dclinum ber;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\nph:=conver t(minpoly,horner);\nvar:=op(remove(type,indets(ph),indexed));\nif not \+ type(eval(clinumber),\{clibasmon,climon,clipolynom\}) \n then return subs(var=clinumber,ph) \nend if;\nif nops(\{var\})<>1 then varx:=op(s elect((member,\{var\},\{x,y,z\}))) else varx:=var end if;\nif nops(\{v arx\})<>1 then \n error \"expecting only one of x, y, or z as a vari able in %1 but found %2\",minpoly,varx \nend if:\nd:=degree(ph,varx); \nh:=ph:\nfor k from 1 to d do\n r[k]:=rem(h,x,x,'s');\n q[k]:=c onvert(s,horner);\nh:=q[k];\nend do:\ndclinumber:=displayid(clinumber) :\nexpr:=clicollect(r[d]*Id+q[d]*dclinumber);\nfor k from d-1 to 1 by \+ -1 do\n expr:=r[k]*Id+'cmul'(expr,dclinumber);\nend do:\nif nargs=2 then return simplify(eval(expr))\nelif nargs=3 then \n if args[3]=' horner' then return expr \n else \n error \"third (optional) argument, when used, must be 'horner', but received %1 instead\",args [3]\n end if;\nelse error \"wrong number of arguments\"\nend if;\nen d proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Procedure " } {TEXT 396 4 "sexp" }{TEXT -1 427 " finds a power series expansion of a Clifford polynomial p up to and including order n modulo the minimal \+ polynomial of p. It is recommended that this procedure be used when n \+ > d, where d is the degree of the minimal polynomial of p. Otherwise, \+ use 'cexp' or 'cexpQ' instead. The reason is that 'sexp' is faster tha n 'cexp' when n > d, but is is slower when n <= d. This procedure can \+ use an optional argument such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 49 "Typical use: sexp(p,4); sexp( p,4,K);sexp(p,4,-K);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1526 "sexp:=proc(p::\{numeric,cliscalar,clibasmon,cl imon,clipolynom\},n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nte,lname ,coB,nameB;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2007`;\n#############################################\nif \+ nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif na rgs=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 nameB:=op(remo ve(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \+ \n error \"wrong type of third argument in sexp. See ?sexp for m ore help.\" \n end if;\nelse\n error \"two or three arguments expe cted in sexp. See ?sexp for more help.\"\nend if;\n################### ##################\nif n=0 then \n if type(p,\{numeric,'cliscalar'\} ) then return 1 else return Id fi\nend if;\nk:='k':\nif type(p,\{numer ic,cliscalar\}) then return add(p^k/k!,k=0..n) end if;\nif evalb(vecto rpart(p,0)=p) then pp:=scalarpart(p);\n return (add(pp^k/k!,k=0..n)* Id) \nend if;\npol:=climinpoly[lname](p,'powers');\npowrs:=pol[2]:\n## # readlib(powmod);\nk:='k':te:='te':\npol:=collect(add(powmod('x',k,po l[1],'x')/k!,k=0..n),'x');\nco:=[coeffs(pol,'x','te')]:\nte:=[te]:\nnt e:=nops(te):\nfor k from 1 to nte do \n te[k]:=powrs[degree(te[k],' x')+1] \nend do;\nreturn clicollect(add(co[k]*te[k],k=1..nte))\nend pr oc:\n" }}{PARA 0 "" 0 "" {TEXT 358 18 "No. 78. Procedure " }{TEXT 397 8 "all_sigs" }{TEXT 398 383 " gives signatures of all real, real simpl e, real semi-simple, complex, quaternionic, quaternionic simple, and q uaternionic semi_simple Clifford algebras up to and including the dime nsion specified as the first parameter. Second parameter, when used, m ust be 'real', 'complex', or 'quat', while the third parameter must be 'simple' or 'semisimple'.\n\nUse: all_sigs(9,'real','simple');\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2807 "all_sigs:=proc(r) \nlocal s1,s2,m i,ma,P,Q,p,q,pq,r_pq,c_pq,q_pq,x,\nsimple_r_pq,simple_q_pq,semisimple_ r_pq,semisimple_q_pq;\noptions `Copyright (c) 1995-2008 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: December 20, 2007`;\n######################################## #####\nif nargs=2 then \n s1:=args[2]:\nelif nargs=3 then \n s1:=a rgs[2]:\n s2:=args[3]:\nend if; \nif not type(r,range) or \n not type(s1,\{string,symbol\}) or\n not type(s2,\{string,symbo l\})\nthen\nWARNING(`try first argument as range, e.g., 1..9, second a rgument as 'real', 'complex', or 'quat', and third arguments as 'simpl e' or 'semisimple' instead of:`);\nreturn 'procname(args)'\nend if;\n# #######################\nmi:=min($r):ma:=max($r):\nP:=\{$0..9\}:Q:=\{$ 0..9\}:\npq:=[]:\nfor p in P do\nfor q in Q do \n if p+q<=ma and p+ q>=mi then pq:=[op(pq),[p,q]] end if: \nend do:\nend do:\nr_pq:=[]:c_p q:=[]:q_pq:=[]:\nfor x in pq do\np:=x[1]:q:=x[2]:\nif member((p - q) m od 8,\{0,1,2\}) then r_pq:=[op(r_pq),x] end if;\nif member((p - q) mod 4,\{3\}) then c_pq:=[op(c_pq),x] end if;\nif member((p - q) mod 8,\{4 ,5,6\}) then q_pq:=[op(q_pq),x] end if;\nend do:\n#################### ##############\nif nargs=1 then return pq end if;\n################### ###############\nif nargs=2 then\n if s1='real' then return r_pq eli f\n s1='complex' then return c_pq elif\n s1='quat' then retu rn q_pq else\n error \"second input string must be 'real', 'compl ex' or 'quat' but received %1\",args[2] \n end if:\nend if: \n##### #############################\nif s1='real' then\n simple_r_pq:=[ ]:semisimple_r_pq:=[]:\n for x in r_pq do \n if member(x [1]-x[2] mod 8,\{1\}) then \n semisimple_r_pq:=[op(semisim ple_r_pq),x] \n else \n simple_r_pq:=[op(simple_r _pq),x]\n end if;\n end do:\n if s2='simple' then r eturn simple_r_pq elif\n s2='semisimple' then return semisimpl e_r_pq else\n error \"third argument must be 'simple' or 'semi simple' but received %1\",args[3]\n fi\nend if;\n################ ##################\nif s1='complex' then\n if s2='simple' then retur n c_pq elif\n s2='semisimple' then return [] \n end if:\nend if ;\n##################################\nif s1='quat' then\n simple _q_pq:=[]:semisimple_q_pq:=[]:\n for x in q_pq do \n if \+ member(x[1]-x[2] mod 8,\{5\}) then \n semisimple_q_pq:=[op (semisimple_q_pq),x] \n else \n simple_q_pq:=[op( simple_q_pq),x]\n end if;\n end do:\n if s2='simple ' then return simple_q_pq elif\n s2='semisimple' then return s emisimple_q_pq else\n error \"third argument must be 'simple' \+ or 'semisimple' but received %1 instead\",args[3]\n end if:\nend \+ if;\nerror \"wrong number of arguments. See ?all_sigs for more help.\" \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 357 18 "No. 79. Procedure " } {TEXT 399 9 "adfmatrix" }{TEXT 400 116 " accomplishes addition of two \+ matrices of type 'dfmatrix', that is, matrices whose entries belong to a double field\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 370 "adfmatrix:=pr oc(M1::dfmatrix, M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1 995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: December 20, 2007`;\n################# ############################\n L1:=ddfmatrix(M1);\n L2:=ddfmatri x(M2);\n return cdfmatrix(evalm(L1[1] + L2[1]), evalm(L1[2] + L2[2] ))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 361 22 "No. 80 /81: Procedures " }{TEXT 403 9 "beta_plus" }{TEXT 404 5 " and " } {TEXT 401 10 "beta_minus" }{TEXT 402 374 " [originally procedure 'beta ' from the package 'double'] are now part of \"CLIFFORD\". They give t wo scalar bilinear forms in the spinor ideal S of Cl(Q).\n\nUsage: bet a_plus(psi,phi,f); beta_plus(psi,phi,f),'s'); beta_minus(psi,phi,f); b eta_minus(psi,phi,f),'s'); where psi and phi are spinors, f is an idem potent, and 's' is an optional argument that will store 'purescalar'. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2005 "beta_plus:= proc(psi,phi,f) \nlocal locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars ,flagf;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-2008 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n################################# ############\nif not _prolevel then\n if not type(psi,\{cliscalar,clib asmon,climon,clipolynom\}) then \n error \"first argument must be of \+ type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n end if; \n if not type(phi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n \+ error \"second argument must be of type 'cliscalar', 'clibasmon', 'cl imon', or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-computed \+ data and check if idempotents are the same\nlocdata:=clidata(B):\nlocf :=eval(locdata[4]);\nKbas:=locdata[6];\nif nops(Kbas)>1 then\n flagf :=evalb(f=eval(locf) or f=gradeinv(locf) or \n f=-grade inv(locf) or f=-eval(locf));\n if not flagf then\nerror \"when K = C or K = H, primitive idempotent f = plus/minus clidata(B)[4] or its gr ade involution\"\n end if;\nend if;\n###\n y:=cmul(reversion(expa nd(psi)),expand(phi));\n if y = 0 then return 0 end if;\n m := ' m';i:='i':\n flag := false;\n mons := cbasis(linalg[coldim](B)); \n v := array(1 .. nops(Kbas),[]);\n lambda := add(v[i]*Kbas[i], i=1..nops(Kbas));\n for m in mons while not flag do\n uu := \+ m;\n eq := clicollect(cmul(m,y) - expand(cmul(lambda,f)));\n \+ sys := \{coeffs(eq, cliterms(eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n sol := solve(sys, vars);\n fl ag := not evalb(sol = NULL)\n end do:\n if nargs = 4 then\n \+ if not type(args[4],name) or type(args[4],protected) then \n \+ error \"fourth optional argument, when used, must be of type unprote cted name\"\n else assign(args[4],uu) \n end if;\n end \+ if;\n lambda:=subs(sol,lambda):\n if vectorpart(lambda,0)=lambda then return (scalarpart(lambda)) \n else return lambda\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2037 "beta_minus:= proc(psi,phi,f) \nlocal locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,s ol,Kbas,v,i,vars,flagf;\nglobal B,_prolevel;\noptions `Copyright (c) 1 995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: December 20, 2007`;\n################# ############################\nif not _prolevel then\n if not type(psi, \{cliscalar,clibasmon,climon,clipolynom\}) then \n error \"first argu ment must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolyno m'\" \n end if;\n if not type(phi,\{cliscalar,clibasmon,climon,clipoly nom\}) then \n error \"second argument must be of type 'cliscalar', 'c libasmon', 'climon', or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-computed data and check if idempotents are the same\nlocdata := c lidata(B):\nlocf := eval(locdata[4]);\nKbas := locdata[6];\nif nops(Kb as)>1 then\n flagf:=evalb(f=eval(locf) or f=gradeinv(locf) or \n \+ f=-gradeinv(locf) or f=-eval(locf));\n if not flagf then \n error \"when K = C or K = H, primitive idempotent f = plus/min us clidata(B)[4] or its grade involution\"\n end if;\nend if;\n###\n y := cmul(conjugation(expand(psi)),expand(phi));\n if y = 0 the n return 0 end if;\n m := 'm';i:='i':\n flag := false;\n mons := cbasis(linalg[coldim](B));\n v := array(1 .. nops(Kbas),[]);\n \+ lambda := add(v[i]*Kbas[i],i=1..nops(Kbas));\n for m in mons whi le not flag do\n uu := m;\n eq := clicollect(cmul(m,y) - expand(cmul(lambda,f)));\n sys := \{coeffs(eq, cliterms(eq))\} ;\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n sol := solve(sys, vars);\n flag := not evalb(sol = NULL)\n end do: \n if nargs = 4 then\n if not type(args[4],name) or type(args [4],protected) then \n error \"fourth optional argument, when used, must be of type unprotected name\"\n else assign(arg s[4],uu) \n end if;\n end if;\n lambda:=subs(sol,lambda): \n if vectorpart(lambda,0)=lambda then \n return scalarpart(l ambda) \n else \n return lambda\n end if;\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 362 18 "No. 82. Procedure " }{TEXT 405 9 "cdfmat rix" }{TEXT 406 100 " creates a matrix over double field from a list o f two matrices or from a serquence of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 922 "cdfmatrix:=proc() local l1,l2,L,i,j,m,n,m1,m2,M N;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\nif nargs=1 a nd type(args[1],list(\{matrix,array\})) \n then m1,m2:= \+ evalm(args[1][1]),evalm(args[1][2]);\nelif nargs=2 and type(args[1],\{ matrix,array\}) and type(args[2],\{matrix,array\}) \n th en m1,m2:= evalm(args[1]),evalm(args[2])\nelse error \"wrong number or types of arguments. See ?cdfmatrix for help.\" \nend if;\n l1:=con vert(m1,mlist);\n l2:=convert(m2,mlist);\n L:=[];\n for i to \+ nops(l1) do \n L:=[op(L),[l1[i],l2[i]]] \n end do:\n m: =linalg[rowdim](m1);\n n:=linalg[rowdim](m1);\n MN:=linalg[matri x](m,n,[]);\n for i to m do \n for j to n do MN[i,j]:=L[(i-1 )*n+j] \n end do:\n end do:\n return evalm(MN)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 363 18 "No. 83. Procedure " }{TEXT 407 9 "ddfm atrix" }{TEXT 408 64 " decomposes a matrix over double field into a pa ir of matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 461 "ddfmatrix:=pr oc(M::dfmatrix) local m,n,i,L1,L2,L;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: December 20, 2007`;\n######################### ####################\n m:=linalg[rowdim](M);\n n:=linalg[coldim] (M);\n L:=convert(M,mlist);\n L1:=[seq(L[i][1],i=1..nops(L))];\n L2:=[seq(L[i][2],i=1..nops(L))];\n return [linalg[matrix](m,n,L 1),linalg[matrix](m,n,L2)]\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 364 18 "No. 84. Procedure " }{TEXT 409 11 "diagonalize" } {TEXT 410 42 " tries to diagonalize a symmetric matrix.\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 785 "diagonalize:=proc(m::symmatrix) local locB, flag,i,j,L,v,S,Bdiag;\noptions `Copyright (c) 1995-2008 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: December 20, 2007`;\n######################################## #####\nif linalg[coldim](m)<>linalg[rowdim](m) then\n error \"expect ed a square matrix as input\" \nend if;\nif type(m,diagmatrix) then \n return evalm(m) \nend if; \nL:=[linalg[eigenvects](m)];\nflag:=true :\nfor i from 1 to nops(L) while flag=true do\n if L[i][2]>nops(L[i ][3]) then flag:=false end if: \nend do: \nif not flag then \n error \"since matrix entered does not have a complete set of linearly indep endent eigenvectors, it is not diagonalizable\" \nend if;\nreturn lina lg[diag](seq(seq(L[i][1],j=1..L[i][2]),i=1..nops(L)))\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 365 6 "No. 85" }{TEXT -1 1 "." }{TEXT 366 11 " P rocedure " }{TEXT 411 9 "mdfmatrix" }{TEXT 412 46 " multiplies two mat rices over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 366 "md fmatrix:=proc(M1::dfmatrix,M2::dfmatrix) local L1, L2;\noptions `Copyr ight (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: December 20, 2007`;\n####### ######################################\n L1:=ddfmatrix(M1);\n L2 :=ddfmatrix(M2);\n return cdfmatrix((L1[1]) &cm (L2[1]),(L1[2]) &cm (L2[2]))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 370 18 "No. 86. Proced ure " }{TEXT 413 7 "cocycle" }{TEXT 414 901 " finds an element x in th e given Clifford algebra such that cmul(x,a1) = cmul(a2,x) where a1 an d a2 are the first two arguments of type 'clibasmon', 'climon', or 'cl ipolynom'. \n\nIf only two arguments are passed to the procedure, elem ent x belongs to the Clifford algebra over the lowest dimension dim = \+ max(maxindex(a1),maxindex(a2)). \n\nIf three arguments are used with \+ the third argument being a list of elements of type 'clibasmon', 'clim on', or 'clipolynom', then x belongs to the set generated by a1, a2, a nd the elements in the third list a3. \n\nIf the fourth argument a4 is used, then the third argument is expected to be a list of elements of type 'clibasmon', in which case the procedure searches for x from tha t list.\n\nTypical use:\n\ncocycle(1+2*e1-e1we3,3*e2+e2we4);\ncocycle( 1+2*e1-e1we3,3*e2+e2we4, [e1we2+Id,e1we2we3,e4]);\ncocycle(1+2*e1-e1we 3,3*e2+e2we4, [e1we2,e1we2we3,e4],'clibasmon');\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 1472 "cocycle:=proc(a1::\{clibasmon,climon,clipolynom\} ,\n a2::\{clibasmon,climon,clipolynom\},\n a 3::list(\{clibasmon,climon,clipolynom\}),\n a4::symbol) \+ \nlocal g,v,n,llist,i,d,S,x,y,xy,sys,vars,sol,llist1,llist2,llist3;\no ptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 07`;\n#############################################\n#if a1=a2 then re turn [Id] end if;\nif nargs=4 and member(args[4],\{clibasmon,clibasmon \}) then\n llist:=a3:\n S:=[]:\n for i from 1 to nops(llist) do\n \+ x:=cmul(llist[i],a1): y:=cmul(a2,llist[i]):\n if x-y =0 then\n \+ if x <> 0 and y <> 0 then\n if cmul(llist[i],llist[i]) <> 0 \+ then\n S:=[op(S),llist[i] ]:\n end if: \n end if: \n end if:\n end do:\nreturn S\nend if;\nif nargs=3 then\n llist 1:=`union`(op(map(cliterms,remove(member,\{seq(op(\{cmul(a1,g),cmul(g, a1)\}),g=a3)\},\{0\})))):\n llist2:=`union`(op(map(cliterms,remove(me mber,\{seq(op(\{cmul(a2,g),cmul(g,a2)\}),g=a3)\},\{0\})))):\n llist3: =map(op@cliterms,convert(a3,set)); \n llist:=convert(`union`(llist1, llist2,llist3),list):\n llist:=sort([op(llist),op(cliterms(op(a3)))], bygrade):\nelse\n llist:=cbasis(max(maxindex(a1),maxindex(a2))):\nend if;\nn:=nops(llist):\ng:=add(_X[i]*llist[i],i=1..n);\nvars:=\{seq(_X[ i],i=1..n)\}:\nxy:=clicollect(cmul(g,a1)-cmul(a2,g)):\nsys:=\{coeffs(x y,llist)\};\nsys:=map(normal,sys);\nsol:=solve(sys,vars);\nreturn subs (sol,g)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 374 18 "No. 87. Procedur e " }{TEXT 415 8 "clisolve" }{TEXT 416 103 " for solving equations in \+ a Clifford algebra Cl(B). \n\nTypical use:\n\nclisolve(eq,pp);\nclisol ve(eq,set);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 623 "clisolve:=proc(eq ::\{clibasmon,climon,clipolynom\},indet::\{list,algebraic\}) \nlocal i ,T,vars,sol,sys;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: December 20, 2007`;\n############################################# \nif type(indet,list) then\n vars:=convert(indet,set)\nelse\n vars:= select(type,indets(indet),indexed)\nend if;\nT:=cliterms(eq);\nsys:=\{ coeffs(clicollect(simplify(eq)),T)\};\nsol:=[solve(sys,vars)];\nif typ e(indet,list) then\n return map(allvalues,sol)\nelse\n return map(al lvalues,[seq(subs(sol[i],indet),i=1..nops(sol))])\nend if;\nend proc: \n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 88. This procedure " }{TEXT 372 13 "CLIFFORD_ENV " }{TEXT 417 135 " lists all environnmental varia bles defined in Clifford, Cliplus, GTP, Octonion, and Bigebra packages , when these packages are loaded.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6579 "CLIFFORD_ENV:=proc() global _warnings_flag:\noptions `Copyright \+ (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: December 20, 2007`;\n############ #################################\nif not assigned(Clifford) then \n \+ lprint(`>>> Package Clifford has not been loaded yet. Type 'with(Clif ford)' at the Maple prompt to load it first. <<<`)\nelse\n print('``') ;###Print blank line\n lprint(`>>> Global variables defined in Cliffor d:-setup are now available and have these values: <<<`);\nlprint(`**** ********* Start *************`); \n########################\nlprint('d im_V'=dim_V);\n #(dimension of the carrier space for Cl(V,B))\nif \+ not member(dim_V,\{1,2,3,4,5,6,7,8,9\}) and _warnings_flag then\n lp rint(`Warning, value of dim_V is expected to be a positive integer bet ween 1 and 9, inclusive.`);\n print('``');###Print blank line\nend i f;\n########################\nlprint('_default_Clifford_product'=_defa ult_Clifford_product);\n #(controls whether cmulRS or cmulNUM is \+ used in Clifford product 'cmul')\n#lprint(`Possible values are: 'cmulR S','cmulNUM','cmulgen','cmul_user_defined'.`);\nif not member(_default _Clifford_product,\{'cmulRS','cmulNUM','cmulgen','cmul_user_defined'\} ) \n and _warnings_flag then\n lprint(`****** SERIOUS WARNING **** **`); \n lprint(`>>> Value of _default_Clifford_product was expected to be 'cmulRS', 'cmulNUM', 'cmulgen', or 'cmul_user_defined'. <<<`); \n lprint(`*****************************`);\nend if;\n############## ##########\nlprint('_prolevel'=_prolevel);\n #(controls whether o r not parsing is done)\nif not member(_prolevel,\{true,false\}) and _w arnings_flag then\n lprint(`Warning, value of _prolevel is expected \+ to be true or false.`);\n print('``');###Print blank line\nend if;\n ########################\nlprint('_shortcut_in_minimalideal'=_shortcut _in_minimalideal);\n #(controls flow in procedure 'minimalideal') \nif not member(_shortcut_in_minimalideal,\{true,false\}) and _warning s_flag then\n lprint(`Warning, value of _shortcut_in_minimalideal is expected to be true or false.`);\n print('``');###Print blank line \nend if;\n########################\nlprint('_shortcut_in_Kfield'=_sho rtcut_in_Kfield);\n #(controls flow in procedure 'Kfield')\nif no t member(_shortcut_in_Kfield,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_Kfield is expected to be tru e or false.`);\n print('``');###Print blank line\nend if;\n######### ###############\nlprint('_shortcut_in_spinorKbasis'=_shortcut_in_spino rKbasis);\n #(controls flow in procedure 'spinorKbasis')\nif not \+ member(_shortcut_in_spinorKbasis,\{true,false\}) and _warnings_flag th en\n lprint(`Warning, value of _shortcut_in_spinorKbasis is expected to be true or false.`);\n print('``');###Print blank line\nend if; \n########################\nlprint('_shortcut_in_spinorKrepr'=_shortcu t_in_spinorKrepr);\n #(controls flow in procedure 'spinorKrepr') \nif not member(_shortcut_in_spinorKrepr,\{true,false\}) and _warnings _flag then\n lprint(`Warning, value of _shortcut_in_spinorKrepr is e xpected to be true or false.`);\n print('``');###Print blank line\ne nd if;\n########################\nlprint('_warnings_flag'=_warnings_fl ag);\n #(controls whether some procedures, e.g., 'wedge', give wa rnings)\nif not member(_warnings_flag,\{true,false\}) then\n lprint( `Warning, value of _warnings_flag is expected to be true or false.`); \n print('``');###Print blank line\nend if;\n####################### #\nlprint('_scalartypes'=_scalartypes);\n #(defines types conside red to be 'scalars' by 'clibilinear' and 'clilinear')\n############### #########\nlprint('_quatbasis'=_quatbasis);\n #(defines default q uaternionic basis')\nlprint(`************* End *************`);\nprint ('``');###Print blank line \nend if;\n########################\nif ass igned(Cliplus) then\n print('``');###Print blank line\n lprint(`>>> Gl obal variables defined in Cliplus:-setup are now available and have th ese values: <<<`);\n lprint(`************* Start *************`);\n l print('macro(cmul=climul)');\n #('cmul' is now extended by 'climu l') \n lprint('macro(cmulQ=climul)');\n #('cmulQ' is now extended by 'climul')\n lprint('macro(`&c`=climul)');\n #('&c' is now ext ended by 'climul')\n lprint('macro(`&cQ`=climul)');\n #('&cQ' is \+ now extended by 'climul')\n lprint('macro(reversion=clirev)');\n \+ #('reversion' is now extended by 'clirev')\n lprint('macro(LC=LCbig)') ;\n #('LC' is now extended by 'LCbig')\n lprint('macro(RC=RCbig)' );\n #('RC' is now extended by 'RCbig')\n if _warnings_flag then \+ \n lprint(`Warning, new definitions for type/climon and type/clipo lynom now include &C`);\n end if;\n lprint(`************* End ******** *****`);\n print('``');###Print blank line \nend if;\n\n############## ######################################\n### Executable Bigebra file fo r Maple 6 is Bigebra6\n############################################### #####\nif assigned(Bigebra6) then\n print('``');###Print blank line\n \+ lprint(`>>> Global variables defined in Bigebra:-init are now availabl e and have these values: <<<`);\n lprint(`************* Start ******* ******`);\n lprint('_CLIENV[_SILENT]'=_CLIENV[_SILENT]); #controls me ssaging upon starting 'Bigebra'\n lprint('_CLIENV[_QDEF_PREFACTOR]'=_C LIENV[_QDEF_PREFACTOR]); #prefactor in 'switch'\n lprint(`*********** ** End *************`);\n print('``');###Print blank line\nend if;\n## ########################################\nif assigned(GTP) then\n prin t('``');###Print blank line\n lprint(`************* Start ************ *`);\n lprint(`>>> There are no new global variables or macros in GTP \+ yet. <<<`);\n lprint(`************* End *************`);\n print('``') ;###Print blank line \nend if;\n###################################### ####\nif assigned(Octonion) then\n print('``');###Print blank line\n l print(`>>> Global variables defined in Octonion:-setup are now availab le and have these values: <<<`);\n print('``');###Print blank line\n \+ lprint(`************* Start *************`); \n lprint('_octbasis'=_o ctbasis); #standard octonion basis as Maple global variable\n lprint('_pureoctbasis'=_pureoctbasis); #pure octonion basis as Maple global variable\n lprint('_default_Fano_triples'=_default_Fano_triple s); #default list of Fano triples\n lprint('_default_squares'=_default _squares); #default squares of e1,e2,e3,e4,e5,e6,e7\n lprint('_default _Clifford_product'=_default_Clifford_product); #selects cmulNUM for nu meric B\n lprint(`************* End *************`);\n print('``');### Print blank line \nend if;\n########################################## \n\nreturn NULL\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 373 18 "No. 89. \+ Procedure " }{TEXT 418 13 "makeclibasmon" }{TEXT 419 402 " that takes \+ a list and makes Grassmann basis monomials. It is expected, that the l ist contains positive integers between 1 and 9 inclusive, or symbolic \+ indices consisting of one-character strings. If the list is empty, the n Id is returned. If any two elements in the list are peated, then 0 i s returned. This procedure has a remember table.\n\nTypical use: makec libasmon([]); makeclibasmon([1,7,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 474 "makeclibasmon:=proc(x::list) \nlocal result,N,i;\nop tions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`,remember;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\n N:=nops (x);\n if N = 0 then return Id end if;\n if N > nops(convert(x,set)) then return 0 end if;\n result:=cat(e,x[1]);\n for i from 2 to \+ N do\n result:=cat(result,cat(we,x[i]));\n end do:\nreturn res ult\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 90. Procedure " } {TEXT 474 12 "rd_clibasmon" }{TEXT -1 405 " generates a random Grassma nn basis monomial. It can be used without any arguments in which case \+ default values are used internally, or with 1 or 2 arguments as follow s:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum all owed grade (default 4)\n\nrd_clibasmon(); then NT1 = 9, NT2 = 4 \nrd_clibasmon(a1); then NT1 = a1, NT2 = 4\nrd_clibasmon(a 1,a2); then NT1 = a1, NT2 = a2\n\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1404 "rd_clibasmon:=proc() local ind,NT1,NT2,nt1d,nt2d,L;\noptions ` Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n## ###########################################\n### NT1 = maximum allowed index value (default 9)\n### NT2 = maximum allowed grade (default 4) \+ (must be less than or equal to NT1)\nnt1d,nt2d:=9,4:\n################ #############################\nif nargs=0 then\n NT1,NT2:=nt1d,rand( 0..nt2d)(): #defaults\n L:=[[]]:\nelif nargs=1 then\n if not type( args[1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n \+ error \"argument must be non negative integer between 0 and 9 giving the maximum monomial index\"\n end if;\n NT1,NT2:=args[1],rand(0. .args[1])():\n L:=[[]]: \n elif nargs>=2 then\n if evalb(not \+ type([args],list(nonnegint)) or \n not evalb(args[1]<=9 and args[ 1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) then\nerr or \"first argument must be non negative integer between 0 and 9 givin g maximum monomial index. Second argument must be non negative integer between 0 and first argument giving maximum possible grade. Other arg uments, if present, are ignored.\" \n end if;\n NT1,NT2:=args[1],m in(args[1],args[2]):\n L:=[]:\n end if:\n##############\nL:=[op(L) ,op(combinat[choose](NT1,NT2))];\nind:=sort(L[rand(1..nops(L))()]);\nr eturn Clifford:-makeclibasmon(ind)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 91. Procedure " }{TEXT 475 9 "rd_climon" }{TEXT -1 560 " generates a random Grassmann monomial. It can be used without an y arguments in which case default values are used internally, or with \+ 1, 2, or 3 arguments as follows:\n\nNT1 = maximum allowed index value \+ (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum ab solute value of coefficients allowed (default 12)\n\nrd_climon(); \+ then NT1 = 9, NT2 = 4, NT3 = 12 \nrd_climon(a1); \+ then NT1 = a1, NT2 = 4, NT3 = 12\nrd_climon(a1,a2); then NT1 = a1, NT2 = a2, NT3 = 12\nrd_climon(a1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1993 "rd_climon:=pro c() local rcf,NT1,NT2,NT3,nt1d,nt2d,nt3d;\noptions `Copyright (c) 1995 -2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\n### NT1 = maximum allowed index value (defa ult 9)\n### NT2 = maximum allowed grade (default 4)\n### NT3 = maximum absolute value of coefficient allowed (default 12)\nnt1d,nt2d,nt3d:=9 ,4,12:\n#############################################\nif nargs=0 then \n NT1,NT2,NT3:=nt1d,rand(0..nt2d)(),rand(1..nt3d)(): #defaults\neli f nargs=1 then\n if not type(args[1],nonnegint) or not evalb(args[1] <=9 and args[1]>= 0) then\n error \"argument must be non negative integer between 0 and 9 giving the maximum monomial index\"\n end i f;\n NT1,NT2,NT3:=args[1],rand(0..args[1])(),rand(1..nt3d)(); \nelif nargs=2 then\n if evalb(not type([args],list(nonnegint)) or \n \+ not evalb(args[1]<=9 and args[1]>=0) or\n not evalb( args[2]<=args[1] and args[2]>=0)) then\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. S econd argument must be non negative integer between 0 and first argume nt giving maximum possible grade.\"\n end if;\n NT1,NT2,NT3:=args[ 1],min(args[1],args[2]),rand(1..nt3d)():\nelif nargs>=3 then\n if ev alb(not type([args],list(nonnegint)) or \n not evalb(args[1 ]<=9 and args[1]>=0) or\n not evalb(args[2]<=args[1] and ar gs[2]>=0)) then\nerror \"first argument must be non negative integer b etween 0 and 9 giving maximum monomial index. Second argument must be \+ non negative integer between 0 and first argument giving maximum possi ble grade. Third argument must be a positive integer giving max value \+ of coefficient. Other arguments, if present, are ignored.\"\n end if ;\n NT1,NT2,NT3:=args[1],min(args[1],args[2]),args[3]:\nend if:\n### ##########\nrcf:=[rand(-NT3..-1)(),rand(1..NT3)()]:\nrcf:=rcf[rand(1.. nops(rcf))()];\nreturn rcf*rd_clibasmon(NT1,NT2)\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT -1 18 "No. 92. Procedure " }{TEXT 476 13 "rd_cli polynom" }{TEXT -1 761 " generates a random Grassmann polynomial. It c an be used without any arguments in which case default values are used internally, or with 1, 2, 3, or 4 arguments as follows:\n\nNT1 = maxi mum allowed index value (default 9)\nNT2 = maximum allowed grade (defa ult 4)\nNT3 = maximum absolute value of coefficients allowed (default \+ 12)\nNT4 = maximum number of terms allowed (default 4)\n\nrd_clipolyn om(); then NT1 = 9, NT2 = 4, NT3 = 12, NT4 = 4 \n rd_clipolynom(a1); then NT1 = a1, NT2 = 4, NT3 = 12, \+ NT4 = 4\nrd_clipolynom(a1,a2); then NT1 = a1, NT2 = a2, NT 3 = 12, NT4 = 4\nrd_clipolynoma1,a2,a3); then NT1 = a1, NT2 = a 2, NT3 = a3, NT4 = 4\nrd_clipolynom(a1,a2,a3,a4); then NT1 = a1, NT2 = a2, NT3 = a3, NT4 = a4\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3536 "rd _clipolynom:=proc() \nlocal rnt,rcf,NT1,nt1d,NT2,nt2d,NT3,nt3d,NT4,nt4 d,L,newL,i,inde,x,m;\noptions `Copyright (c) 1995-2008 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: December 20, 2007`;\n######################################### ####\n### NT1 = maximum allowed index value (default 9)\n### NT2 = max imum allowed grade (default 4) (must be leq. than NT1)\n### NT3 = maxi mum absolute value of coefficient allowed (default 12)\n### NT4 = maxi mum number of terms allowed (default 5)\nnt1d,nt2d,nt3d,nt4d:=9,4,12,5 :\n#####################################################\nif nargs=0 t hen\n NT1,NT2,NT3,NT4:=\n nt1d,rand(0..nt2d)(),rand(1..nt3d)(),ran d(1..nt4d)(): #defaults\nelif nargs=1 then\n if not type(args[1],non negint) or not evalb(args[1]<=9 and args[1]>= 0) then\n error \"a rgument must be non negative integer between 0 and 9 giving the maximu m monomial index\"\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..ar gs[1])(),\n rand(1..nt3d)(),rand(1..nt4d)():\nelif \+ nargs=2 then\nif evalb(not type([args],list(nonnegint)) or \n \+ not evalb(args[1]<=9 and args[1]>=0) or\n not evalb(args [2]<=args[1] and args[2]>=0)) then\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. Secon d argument must be non negative integer between 0 and first argument g iving maximum possible grade.\"\n end if;\n NT1,NT2,NT3,NT4:=args[ 1],rand(0..min(args[1],args[2]))(),\n rand(1..nt3d) (),rand(1..nt4d)(): \nelif nargs=3 then\n if evalb(not type([args], list(nonnegint)) or \n not evalb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) then\nerr or \"first argument must be non negative integer between 0 and 9 givin g maximum monomial index. Second argument must be non negative integer between 0 and first argument giving maximum possible grade. Third arg ument must be a positive integer giving max value of coefficient.\";\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(args[1],args[2]))( ),\n args[3],rand(1..nt4d)():\nelif nargs>=4 then\n if evalb(not type([args],list(nonnegint)) or \n not eval b(args[1]<=9 and args[1]>=0) or\n not evalb(args[2]<=args[1 ] and args[2]>=0)) then\nerror \"first argument NT1 must be non negati ve integer between 0 and 9 giving maximum monomial index. Second argum ent NT2 must be non negative integer between 0 and NT1 (inclusive) giv ing maximum possible grade. Third argument NT3 must be a positive inte ger giving max value of coefficient. Fourth argument NT4 must be a pos itive integer giving maximum number of terms (it is expected to be no \+ larger that number of combinations NT1 choose NT2. Other arguments, if present, are ignored.\"\n end if:\n NT1,NT2,NT3,NT4:=args[1],min( args[1],args[2]),args[3],args[4]:\nend if:\n#############\n### NT1 = m aximum allowed index value (default 9)\n### NT2 = maximum allowed grad e (default 5)\n### NT3 = maximum absolute value of coefficient allowed (default 12)\n### NT4 = maximum number of terms allowed (default 4)\n #############\nL:=\{\}:\nfor i from 0 to NT2 do\n L:=\{op(L),op(com binat[choose](NT1,i))\};\nend do:\nm:=min(nops(L),NT4):\nL:=convert(L, list):\nnewL:=[[],[[]]]:\nnewL:=newL[rand(1..2)()]:\nfor i from 1 to m do\n inde:=rand(1..nops(L))();\n x:=L[inde];\n newL:=[op(new L),x];\n L:=subsop(inde=NULL,L);\nend do;\nL:=map(makeclibasmon,new L);\nrcf:=[rand(-NT3..-1)(),rand(1..NT3)()]:\nreturn add(rcf[rand(1..n ops(rcf))()]*L[i],i=1..nops(L))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. Initialization procedure " }{TEXT 420 5 "setup" } {TEXT -1 26 " for the Clifford package." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 94 "This package is loaded automatic ally into Maple session when command with(Clifford); is given." }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1633 "s etup:=proc() \nlocal x,y,i,j;\nglobal libname,B,\n_quatbasis,qi,qj,qk, \n_prolevel,\n_shortcut_in_minimalideal,\n_shortcut_in_Kfield,\n_short cut_in_spinorKbasis,\n_shortcut_in_spinorKrepr,\ndim_V,\n_warnings_fla g,\n_scalartypes,\n_CLIENV,\n_default_Clifford_product,\npause,\n##### ##############################\n`convert/dfmatrix`,`convert/mlist`,`co nvert/str_to_int`,`type/clibasmon`,\n`type/antisymmatrix`,`type/climat rix`,`type/climon`,`type/clipolynom`,\n`type/cliprod`,`type/cliscalar` ,`type/dfmatrix`,`type/diagmatrix`, `type/evenelement`,`type/fieldelem ent`,`type/gencomplex`,`type/genquatbasis`,\n`type/genquaternion`,`typ e/idempotent`,`type/nilpotent`,`type/oddelement`,\n`type/primitiveidem p`,`type/purequatbasis`,`type/quaternion`,\n`type/symmatrix`,`type/ten sorprod`,\n`&c`,`&cQ`,`&cQm`,`&cm`,`&om`,`&q`,`&qm`,`&rm`,`&w`,`&wm`; \n###################################\noptions `Copyright (c) 1995-200 8 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2007`;\n######################## #################################\n_prolevel:=false: #a ssigning default value\n_shortcut_in_minimalideal:=true: #assigning de fault value\n_shortcut_in_Kfield:=true: #assigning default value \n_shortcut_in_spinorKbasis:=true: #assigning default value\n_shortcut _in_spinorKrepr:=true: #assigning default value\n_warnings_flag:=true : #assigning default value\ndim_V:=9: \+ #default value\n_scalartypes:=\{RootOf,mathfunc,function,numeric,rat ional,constant,indexed,complex,`^`\}:\n_CLIENV[_QDEF_PREFACTOR]:=-1:\n _default_Clifford_product:=cmulRS: #default Clifford product\n" }} {PARA 0 "" 0 "" {TEXT 371 98 "(1) Global variable _scalartypes contain s all types declared by the user to be of type 'scalar'. \n" }}{PARA 258 "" 0 "" {TEXT -1 303 "(2) Standard quaternion basis as Maple globa l variable as in P. Lounesto \"Clifford Algebras and Spinors\", page 4 9. To avoid conflicts with i, j, k, etc. traditionally used in summat ions, loops, user could define qi, qj, and qk in place of \{i, j, k\} \+ used to denote pure quaternion part of a quaternion.\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 95 "_quatbasis:=[[Id,e3we2,e1we3,e2we1],\{`Maple h as assigned qi:=-e2we3, qj:=e1we3, qk:=-e1we2`\}];\n" }}{PARA 0 "" 0 " " {TEXT 367 48 "(3) Defining abbreviations for quaternion basis:" } {TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "unprotect(qi,qj,q k);\nqi:=-e2we3:\nqj:=e1we3:\nqk:=-e1we2:\n" }}{PARA 0 "" 0 "" {TEXT 368 31 "(4) Defining useful functions:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 "pause:=proc(s::nonnegint) local s1:\ns1:=time():\nwhi le time()-s1 < s do od end proc:" }}{PARA 0 "" 0 "" {TEXT 369 37 "\n(5 ) Protecting all procedure names:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "protect(Clifford,e,'qi','qj','qk',Id,w);\n" }}{PARA 258 "" 0 "" {TEXT 473 22 "Types and conversions:" }{TEXT -1 32 "\n\nNo. 1. Definit ion of the type " }{TEXT 436 9 "clibasmon" }{TEXT -1 87 ", i.e., a bas is monomial. \n\nTypical use: type(e2we1,clibasmon); type(e1we2,clibas mon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 946 "`type/clibasmon`:=proc( a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst,N;\noptions `Copyright (c) \+ 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 20, 2007`;\n################ #############################\n#a1:=simplify(eval(a)):\na1:=eval(a): # no simplify here\n if a1 = Id then return true end if:\n if type(a 1,\{string,name,symbol\}) then\n str:=convert(a1,string);\n ls t:=[seq(str[i],i=1..length(a1))];\n N:=(nops(lst)+1)/3;\n if N =1 then \n e_set:=\{lst[1]\};\n w_set:=\{\"w\"\};\n \+ ind_lst:=[lst[2]];\n else\n e_set:=\{seq(lst[3*i-2],i=1..N) \};\n w_set:=\{seq(lst[3*i],i=1..N-1)\};\n ind_lst:=[seq(l st[3*i-1],i=1..N)];\n end if:\n# print(e_set,w_set,ind_lst,N,lst); \n if (e_set=\{\"e\"\}) and (w_set=\{\"w\"\}) and (N=nops(\{op(ind _lst)\})) then\n return true\n else\n return false \n \+ end if:\n else\n return false \n end if: \nend proc:\n" } }{PARA 258 "" 0 "" {TEXT -1 30 "No. 2. Definition of the type " } {TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e., Clifford scalar. A Clif ford scalar is essentially any number, function, constant, or an algeb raic expression not containing any basis monomials (this means that 2* Id is not of type 'cliscalar').\n\nTypical use: type(e1+e2we3+2*Pi*B[1 ,2],cliscalar);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 764 "`type/cliscal ar`:=proc(a::anything) local a1,locscalartypes;\nglobal `&C`,_scalarty pes; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\na1:=simpl ify(eval(a)):\nlocscalartypes:=remove(member,_scalartypes,\{`^`\}):\ni f type(a1,\{matrix,list\}) or hastype(a1,clibasmon) or \n hastype(a1 ,tensorprod) or has(a1,`&C`) then return false \nend if: \nif type(a1 ,locscalartypes) or evalb(op(map(type,\{op(a1)\},locscalartypes))=true )\n then return true \nend if:\nif type(a1,`^`) then\n if select( hastype,\{a1\},clibasmon)=\{\} then\n return true else error \"il legal expression in %1\",a1 \n end if:\nend if:\nreturn cliparse(a1) \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 31 "No. 3. Definition of \+ the type " }{TEXT 438 6 "climon" }{TEXT -1 197 ", i.e., Clifford monom ial. A Clifford monomial is essentially any basis monomial (of type 'c libasmon') multiplied by a Clifford scalar (of type 'cliscalar').\n\nT ypical use: type(e1we2+2*e2,climon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 762 "`type/climon`:=proc(x1) local x,S,xx,flag6plus:\noptions `Cop yright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2007`;\n##### ########################################\nx:=simplify(eval(x1)):\nflag 6plus:=assigned(Cliplus):\nif hastype(x,cliprod) and not flag6plus and _warnings_flag then \n WARNING(`argument to 'type/climon' contains \+ type 'cliprod'. Load 'Cliplus' to extend functionality of CLIFFORD. T ype ?cliprod for help.`);\nend if:\n##################\nif not flag6pl us then S:=\{'clibasmon'\} else S:=\{'clibasmon','cliprod'\} end if:\n xx:=simplify(x):\nif type(xx,cliscalar) then false\nelif evalb(type(xx ,`*`) and nops(select(type,\{op(xx)\},S))=1) then\n true \nelse \n f alse\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "No. 4. De finition of the type " }{TEXT 439 10 "clipolynom" }{TEXT -1 265 ", i.e ., Clifford polynomial. A Clifford polynomial is a multivariate polyn omial in the unknowns of type 'climon' or 'cliprod', i.e., Clifford mo nomial, with coefficients of the type 'cliscalar', i.e., Clifford scal ar.\n\nTypical use: type(e1+2*Pi*e2we3,clipolynom);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 980 "`type/clipolynom`:=proc(x1) local x,flag6plus: \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\n#x:=simplify(e val(x1)):\nx:=eval(x1): #no somplify here\nif type(eval(x),\{matrix,li st,set,cliscalar\}) or \n (not type(eval(x),algebraic)) \+ or \n hastype(eval(x),tensorprod) then \nreturn false \+ \nend if:\nflag6plus:=assigned(Cliplus):\nif hastype(x,cliprod) and n ot flag6plus and _warnings_flag then \n WARNING(`argument to 'type/c lipolynom' contains type 'cliprod'. Load 'Cliplus' to extend function ality of CLIFFORD. Type ?cliprod for help.`);\nend if:\nif evalb(not f lag6plus and type(expand(x),`+`) and hastype(x,clibasmon) and not hast ype(x,cliprod)) \n then return true \nend if:\nif evalb(flag6plus a nd type(expand(x),`+`) and hastype(x,\{clibasmon,cliprod\})) then \n \+ return true \nend if: \nreturn false \nend proc:" }}{PARA 0 "" 0 "" {MPLTEXT 0 21 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 432 24 " No. 5. Converts strings " }{TEXT 440 10 "str_to_int" }{TEXT 441 98 " : `1`, `2`, ..., `0` to appropriate digit.\n\nTypical use: map(convert, extract(e1we2),str_to_int);\n" }{MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 648 "`convert/str_to_int`:=proc(a1::symbol)\noptions `C opyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 20, 20 07`;\nreturn parse(a1);\n############################################# \nif args[1] = `0` then return 0 elif\n args[1] = `1` then return 1 \+ elif\n args[1] = `2` then return 2 elif\n args[1] = `3` then retur n 3 elif\n args[1] = `4` then return 4 elif\n args[1] = `5` then r eturn 5 elif\n args[1] = `6` then return 6 elif\n args[1] = `7` th en return 7 elif\n args[1] = `8` then return 8 elif\n args[1] = `9 ` then return 9 else\n return a1\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 6. Definition of type " }{TEXT 442 9 "nilpote nt" }{TEXT -1 914 ". The following procedure verifies whether or not \+ its non-zero argument is a nilpotent element in the given Clifford alg ebra Cl(B). It is expected that a matrix of the bilinear form B has b een specified. If the element happens to be an idempotent, or if som e power of that element equals the element itself, or if the element i s of type 'cliscalar' then the procedure returns 'false'. Otherwise, the procedure checks if any power of its argument up to and including order of 2^N, where N is the maximum index found in the input, is zer o.\n\nThis procedurecan also test for nilpotency w.r.t. to a name/symb ol/matrix/array which may be passed on as a second element of list why the first element in the list is the element to be checked for nilpot ency. \n\nTypical use: type((1/2)*(e1 +e1we3),nilpotent); #this is a nilpotent element in Cl(3,0) \ntype(p,nilpotent);\ntype([p,K],nilpote nt);\ntype([p,-K],nilpotent);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2104 "`type/nilpotent`:=proc(a11) \nlocal a1,i,x,y,xx,k,flagB,S,lname, flagindexed;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: December 20, 2007`;\n######################################## #####\n##########################################\n##This code allows \+ for passing name of the matrix K as a second element in a list:\n##To \+ test element p for nilpotency w.r.t. matrix K enter [p,K];\n##To test \+ element p for nilpotency w.r.t. B enter p, or, [p,B].\n############### ###########################\nif type(a11,\{cliscalar,clibasmon,climon, clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flagindexed:=false :\n if not type(B,matrix) then error \"matrix must be assigned to B\" \n else flagB:=type(B,diagmatrix) \n end if:\neli f type(a11,list) then\n if nops(a11)<>2 then error \"list must have \+ exactly two elements\"\n elif not type(a11[1],\{cliscalar,clibasm on,climon,clipolynom\}) or\n not type(a11[2],\{name,symbol,m atrix,array,`&*`(numeric,\{name,symbol,matrix,array\})\})\n then \+ error \"list must contain clipolynom and name\"\n else\n a1:=a11[1 ]:\n lname:=a11[2]:\n flagindexed:=true:\n if not type(evalm( lname),matrix) then error \"matrix must be assigned to %1\",lname \+ \n else flagB:=type(evalm(lname),diagmatrix) \n end if: \+ \n end if:\nelse\n error \"unexpected argument type\"\nend if:\n## #################################\nx:=displayid(a1):\nif a1=0 then ret urn true \n elif type(a1,cliscalar) then \n return fals e \n elif (type(x,clibasmon) and flagB and linalg[det](evalm(lname) )<>0) then \n return false \nend if:\n################### #################\nxx:=cmul[lname](x,x):\nif evalb(xx=0) then return t rue end if:\nif evalb(simplify(xx-x)=0) or not evalb(solve(xx=k*x,k)=N ULL) then return false end if:\ny:=xx:\nfor i from 1 to 2^maxindex(a1) do\n if y=vectorpart(y,0) or y=x then return false end if: \n \+ y:=cmul(x,y);\n if y=0 then return true end if:\n en d do:\nerror \"Sorry, but I am unable to determine nilpotency of %1\", a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7. Definition of type " }{TEXT 443 10 "idempotent" }{TEXT -1 311 ". The following pro cedure verifies whether or not its argument is an idempotent in the gi ven Clifford algebra Cl(B). It is expected that a matrix of the bilin ear form B has been specified. It can also check element p for being i dempotent in Cl(K) if K is entered as a second argument in a list such as [p,K].\n" }}{PARA 0 "" 0 "" {TEXT 431 124 "Typical use: type((1/2) *(1 + e1),idempotent); #this is an idempotent in Cl(3,0)\ntype(p,idem potent);\ntype([p,K],idempotent);" }}{PARA 0 "" 0 "" {TEXT 435 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1578 "`type/idempotent`:=proc(a11) \nlo cal f,ff,lname,a1,flagindexed,flagB; global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: December 20, 2007`;\n############### ##############################\n###################################### ####\n##This code allows for passing name of the matrix K as a second \+ element in a list:\n##To test element p for being idempotent w.r.t. ma trix K enter [p,K];\n##To test element p for being idempotent w.r.t. B enter p, or, [p,B].\n##########################################\nif t ype(a11,\{cliscalar,clibasmon,climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flagindexed:=false:\n if not type(B,matrix) th en error \"matrix must be assigned to B\" \n else flagB:=ty pe(B,diagmatrix) \n end if:\nelif type(a11,list) then\n if nops (a11)<>2 then error \"list must have exactly two elements\"\n eli f not type(a11[1],\{cliscalar,clibasmon,climon,clipolynom\}) or\n \+ not type(a11[2],\{name,symbol,matrix,array,`&*`(numeric,\{name,s ymbol,matrix,array\})\})\n then error \"list must contain clipoly nom and name\"\n else\n a1:=a11[1]:\n lname:=a11[2]:\n flagind exed:=true:\n if not type(evalm(lname),matrix) then error \"matri x must be assigned to %1\",lname \n else flagB:=type(evalm( lname),diagmatrix) \n end if: \n end if:\nelse\n error \"unex pected argument type\"\nend if:\n##################################### ###\nf:=displayid(a1):\nff:=cmul[lname](f,f):\nif evalb(ff=0) then ret urn false end if:\nreturn evalb(simplify(ff-f)=0)\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 8. A new type " }{TEXT 444 9 "clima trix" }{TEXT -1 424 " is a matrix with at least one entry of type 'cli polynom'. Note that anything in Maple that has been defined via the pr ocedure linalg[matrix] is of the standard Maple type 'matrix' includin g matrices with entries in a Clifford algebra. Since a matrix with num erical entries is not of the type 'climatrix', this procedure allows o ne to distinguish such matrix from those that do have at least one ent ry in a Clifford algebra." }}{PARA 258 "" 0 "" {TEXT -1 208 "\nMatrice s of the type 'matrix' but not 'climatrix' may be multiplied using sta ndard Maple matrix multiplication operator `&*`.\n\nMatrices of the ty pe 'climatrix' must be multiplied using the procedure 'rmulm'." }} {PARA 0 "" 0 "" {TEXT 430 104 "\nTypical use: M:=linalg[matrix](2,2,[e 1,e3we4+e3,e4,Id-e1]);\n type(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 356 "`type/climatrix`:=proc(x)\noptio ns `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: December 20, 2007`; \n#############################################\nif type(x,array) then \n return evalb(select(type,convert(x,set),\{clipolynom,climon,clibas mon\})<>\{\})\nelse \n return false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Useful conversion function to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " needed by 'rmulm'.\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 369 "`convert/mlist`:=proc(a1::matrix) local i,longlist ;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: December 20 , 2007`;\n#############################################\nlonglist:=[]: \nfor i from 1 to linalg[rowdim](a1) do\nlonglist:=[op(longlist),op(co nvert(linalg[row](a1,i),list))] od\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 428 19 "No. 10. A new type " }{TEXT 447 12 "fieldelement" } {TEXT 448 2 ":\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 548 "`type/fieldele ment`:=proc(a1::algebraic) global f; \noptions `Copyright (c) 1995-200 8 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2007`;\n######################## #####################\nif not assigned(f) then \n error \"primitive \+ idempotent f has not been assigned yet\" \nend if:\nif not type(f,prim itiveidemp) then \n error \"although f has been assigned, it is not \+ of type/primitiveidemp\"\nend if:\nif member(squaremodf(args[1],f),\{- 1,1\}) then return true else return false end if \nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 427 20 "No. 11. A new type: " }{TEXT 449 9 "symm atrix" }{TEXT 450 25 " - a symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 470 "`type/symmatrix`:=proc(a1::\{name,symbol,matrix,`&*` (algebraic,matrix)\}) \noptions `Copyright (c) 1995-2008 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n####################################### ######\nif evalb(evalm(a1)=a1) then return false end if:\nif linalg[co ldim](a1)<>linalg[rowdim](a1) then\n error \"B must be assigned squa re matrix\" \nend if:\nreturn linalg[equal](a1,linalg[transpose](a1)) \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 426 20 "No. 12. A new type: " } {TEXT 451 13 "antisymmatrix" }{TEXT 452 31 " - an anti-symmetric mat rix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 475 "`type/antisymmatrix`:=pr oc(a1::\{name,symbol,matrix,`&*`(algebraic,matrix)\}) \noptions `Copyr ight (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: December 20, 2007`;\n####### ######################################\nif evalb(evalm(a1)=a1) then re turn false end if:\nif linalg[coldim](a1)<>linalg[rowdim](a1) then\n \+ error \"B must be assigned square matrix\" \nend if:\nreturn linalg[e qual](a1,-linalg[transpose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A new type: " }{TEXT 453 10 "diagmatrix" }{TEXT 454 25 " - a diagonal matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 483 "`type/diagmatrix`:=proc(a1::anything) local N,i,DD;\noptions `Cop yright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2007`;\n##### ########################################\nif not type(a1,\{matrix,`&*` (algebraic,matrix)\}) then return false end if:\nif not type(a1,symmat rix) then return false end if:\n N:=linalg[coldim](a1):\n DD:=linalg [diag](seq(a1[i,i],i=1..N)):\n return linalg[iszero](evalm(a1-DD))\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. New type: " } {TEXT 455 14 "primitiveidemp" }{TEXT -1 1109 " - primitive idempotent. This procedure determines the number of factors in the given idempot ent of the type (1/2)*(Id+e[i]), i=1..n, where \{e[i],i=1..n\} is a se t of commuting basis monomials with square equal to 1 mod Id. \nIt ret urns 'true' if n = q - RHnumber(q-p), where 'RHnumber' is the Radon-H urwitz function and [p,q] is signature of the current quadratic form w hich is assumed to have been defined, i.e., the bilinear form B has be en defined as a diagonal matrix, and 'false' if n < q - RHnumber(q-p). \n\nIf the argument is the identity element 'Id' of the algebra Cl(Q), the procedure checks if Cl(Q) is simple or semi-simple, and it return s 'true' or 'false' respectively. It is known that when Cl(Q) is semi -simple, 'Id' can be written as a sum of mutually annihilating idempot ents (1/2)*(Id+p) and (1/2)*(Id-p), where p is the unit pseudo-scalar \+ element (volume element) in Cl(Q).\n\nThe procedure expects that the b ilinear form B has been defined as a diagonal matrix.\n\nTypical use: \+ type(cmul((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),primitiveidemp);\n \+ type(Id,primitiveidemp);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 509 "`type/primitiveidemp`:=proc(f::idempotent) local p,q ,numfact;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: December 20, 2007`;\n########################################### ##\nif not type(B,matrix) then \n error \"B must be assigned square \+ matrix\" \nelse\n p:=Bsignature(B)[1]:q:=Bsignature(B)[2]\nend if:\n numfact:=q-RHnumber(q-p):\nif scalarpart(f)=1/2^numfact then \n retu rn true \nelse \n return false \nend if:\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 13 "No. 15. Type " }{TEXT 456 13 "purequatbasis" } {TEXT -1 109 " is a procedure which checks if the given list of three \+ basis monomials can be a basis for pure quaternions.\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 921 "`type/purequatbasis`:=proc(l1::list(\{clibasm on,climon,clipolynom\})) \nlocal p,q,r;global B;\noptions `Copyright ( c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: December 20, 2007`;\n############# ################################\nif nops(l1) <> 3 then \n error \"l ist must have exactly 3 elements of type 'clibasmon', 'climon', or 'cl ipolynom' but received a list with %1 elements\",nops(l1)\nend if:\nif not type(B,matrix) then \n error \"square matrix must be assigned t o B\"\nend if: \np:=l1[1]:q:=l1[2]:r:=l1[3]:\nif cmul(p,p)<>-Id then r eturn false elif\n cmul(q,q)<>-Id then return false elif\n cmul(r, r)<>-Id then return false elif\n not member(cmul(p,q),\{r,-r\}) then return false elif\n cmul(p,q)+cmul(q,p)<>0 then return false elif\n cmul(p,r)+cmul(r,p)<>0 then return false elif\n cmul(q,r)+cmul(r, q)<>0 then return false else\n return true\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 20 "No. 16. A new type: " }{TEXT 457 10 "ge ncomplex" }{TEXT -1 413 " - a generalized complex element of Cl(B). A Clifford polynomial p in Cl(B) is of this type if it belongs to a sub alegbra A of Cl(B) isomorphic to complex numbers C. Knowing that the g iven polynomial p is of that type allows for finding the inverse of p \+ in A < Cl(B) a more efficient way by the procedure 'cinv'.\n\nNote tha t elements of grade 0 (eg., 2*Id) are not of this type.\n\nTypical use : type(p,gencomplex);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 887 "`type/g encomplex`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local \+ L;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2007`;\n#############################################\nif \+ not type(B,matrix) then \n error \"can't check type since B is not a ssigned a matrix\" \nend if:\nif type(a1,cliscalar) then return false \+ end if:\nL:=[op(cliterms(reorder(a1)))];\nif nops(L)>2 then return fal se end if:\nif nops(L)=1 and L=[Id] then return false end if:\nif nops (L)=2 and not member(Id,L) then return false end if:\nL:=remove(member ,L,[Id]);\nif maxindex(L)>linalg[coldim](B) then \n error \"can't ch eck type since the largest index in %1 is greater than size %2 of curr ent form B\", a1,linalg[coldim](B)\nend if:\nif cmul(L[1],L[1])=-Id th en \n return true \nelse \n return false \nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 17. A new type: " }{TEXT 458 13 " genquaternion" }{TEXT -1 513 " - a generalized quaternionic element of Cl(B). A Clifford polynomial p in Cl(B) is of this type if it belong s to a subalegbra A of Cl(B) isomorphic to a division ring H of quater nions. Knowing that the given polynomial p is of that type allows for finding the inverse of p in A < Cl(B) a more efficient way by the pro cedure 'cinv'.\n\nNote that elements of grade 0 (eg., 2*Id) and elemen ts of type 'gencomplex' - a generalized complex element of Cl(B), are \+ not of this type.\n\nTypical use: type(p,genquaternion);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 664 "`type/genquaternion`:=proc(a1::\{cliscalar ,clibasmon,climon,clipolynom\}) local L;global B;\noptions `Copyright \+ (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: December 20, 2007`;\n############ #################################\nif not type(B,matrix) then \n err or \"square matrix must be assigned to B\" \nend if:\nif type(a1,clisc alar) then return false end if:\nL:=[op(cliterms(reorder(a1)))];\nif n ops(L)>4 or type(a1,gencomplex) then return false end if:\nL:=remove(m ember,L,[Id]);\nif nops(L)=1 then return false end if:\nif nops(L)=2 t hen L:=[op(L),cmul(L[1],L[2])] end if:\nreturn type(L,purequatbasis)\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 18/19. Two new types : " }{TEXT 460 11 "evenelement" }{TEXT -1 5 " and " }{TEXT 459 10 "odd element" }{TEXT -1 242 " in Cl(B). These two type-checking procedures determine whether their inputs are even elements, odd elements, or ne ither in Cl(B).\n\nTypical use: type(p,evenelement);\n \+ type(p,oddelement);\n\nwhere p is a Clifford polynomial.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 777 "`type/evenelement`:=proc(a1::\{cli scalar,clibasmon,climon,clipolynom\})\noptions `Copyright (c) 1995-200 8 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2007`;\n######################## #####################\nif type(eval(a1),cliscalar) then return true en d if:\nreturn evalb(reorder(displayid(eval(a1)-gradeinv(eval(a1))))=0) \nend proc:\n\n`type/oddelement`:=proc(a1::\{cliscalar,clibasmon,climo n,clipolynom\})\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2007`;\n############################################# \nif type(eval(a1),cliscalar) then return false end if:\nreturn evalb( reorder(displayid(eval(a1)+gradeinv(eval(a1))))=0)\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 424 18 "No. 20. New type: " }{TEXT 461 10 "quate rnion" }{TEXT 462 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 897 "`type/q uaternion`:=proc(q::algebraic) local aa1,aa2,S;global B,qi,qj,qk;\nopt ions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: December 20, 2007 `;\n#############################################\nif not assigned(B) \+ or not type(B,matrix) then \n error \"bilinear form B has not been a ssigned yet. It must be defined as the identity 3 x 3 matrix.\"\nend i f:\nif not linalg[equal](B,linalg[diag](1$3)) then \n error \"identi ty 3 x 3 matrix must be assigned to B\" \nend if:\nif not type(eval(q) ,\{'clibasmon','climon','clipolynom'\}) then \n error \"wrong input \+ type: input must be of type 'clibasmon','climon', or 'clipolynom'\" \n end if:\naa1:=\{op(cliterms(reorder(expand(eval(q)))))\};\naa2:=\{Id,e 1we2,e1we3,e2we3\};#standard basis to be compared to\nS:=aa1 minus aa2 ;\nif op(S) = NULL then \n return true else return false \nend if: \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 423 17 "No. 21. New type " } {TEXT 463 10 "tensorprod" }{TEXT 464 183 " is needed to include new ty pes from the package 'GTP' for 'Graded Tensor Product'. This is an ex perimental package for computations with graded tensor products of Cli fford algebras." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 333 "`type/tensorprod`:=proc(a1::anything)\noptions `Copyright (c) 199 5-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: December 20, 2007`;\n################### ##########################\nif type(a1,function) and op(0,a1)=`&t` the n return true else return false end if:\nreturn false\nend proc:" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 422 18 "No. 22. New type: " }{TEXT 465 12 "genquatbasis" }{TEXT 466 187 ". This procedure checks if the given list or set of four elem ents is a basis for generalized quaternionic ring.\n\nUse: type([p1,p2 ,p3,p4], genquatbasis);type(\{p1,p2,p3,p4\}, genquatbasis);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1476 "`type/genquatbasis`:=proc(L::\{li st(\{cliscalar,clibasmon,climon,clipolynom\}),\n \+ set(\{cliscalar,clibasmon,climon,clipolynom\})\}) \nlocal f,p, q,k,loc,i;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n#################### #########################\ndescription `Last revised: December 20, 200 7`;\nif nops(L) <> 4 or nops(L)<>nops(convert(L,set)) then \n error \+ \"list or set must have exactly 4 different elements\" \nend if:\nif n ot type(B,matrix) then \n error \"square matrix must be assigned to \+ B first\" \nend if: \nf:=op(select(type,L,idempotent)): #select idempo tent in L\nif f=NULL then \n error \"one element in the list must be an idempotent\" \nend if:\nloc:=remove(member,L,\{f\}); #assig n remaining elements of L to loc \np,q,k:=seq(loc[i],i=1..3): \+ #assign elements of loc to p,q,k\n##################################\n if cmul(p,p)<>cmul(-Id,f) then return false elif\n cmul(q,q)<>cmul(- Id,f) then return false elif\n cmul(k,k)<>cmul(-Id,f) then return fa lse \nend if:\n################################## \nif (cmul(p,q)=cm ul(k,f) and cmul(q,p)=-cmul(k,f) and \n cmul(q,k)=cmul(p,f) and cmu l(k,q)=-cmul(p,f) and \n cmul(k,p)=cmul(q,f) and cmul(p,k)=-cmul(q, f)) \nor\n (cmul(p,q)=-cmul(k,f) and cmul(q,p)=cmul(k,f) and \n c mul(q,k)=-cmul(p,f) and cmul(k,q)=cmul(p,f) and \n cmul(k,p)=-cmul( q,f) and cmul(p,k)=cmul(q,f))\nthen return true \nelse\n return fals e\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 23. New \+ type" }{TEXT 421 2 ": " }{TEXT 467 7 "cliprod" }{TEXT 468 117 "\n\nUse : type(e1we2 &C e3, cliprod); type(`&C`(e1,e2),cliprod); type(`&C`[K]( e1,e2),cliprod); type(&C(e1,e2),cliprod);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 317 "`type/cliprod`:=proc(f::\{function,anything\}) local p;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2007`;\n#############################################\nevalb(membe r(op(0,f),\{`&C`\}) or member(op(0,op(0,f)),\{`&C`\}))\nend proc:\n" } }{PARA 0 "" 0 "" {TEXT 433 18 "No. 24. Procedure " }{TEXT 469 16 "conv ert/dfmatrix" }{TEXT 470 84 " converts a list of matrices or a pair of matrices inot a matrix over double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 969 "`convert/dfmatrix`:=proc() local l1,l2,L,i,j,m,n,m1, m2,MN;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Decemb er 20, 2007`;\n#############################################\nif nargs =1 and type(args[1],dfmatrix) \n then return args[1]\nel if nargs=1 and type(args[1],list(\{matrix,array\})) \n t hen m1,m2:=evalm(args[1][1]),evalm(args[1][2]);\nelif nargs=2 and type (args[1],\{matrix,array\}) and type(args[2],\{matrix,array\}) \n \+ then m1,m2:=evalm(args[1]),evalm(args[2])\nelse error \"wrong number or types of arguments\" \nend if:\n l1 := convert(m1,mlist) ;\n l2 := convert(m2,mlist);\n L := [];\n for i to nops(l1) d o L := [op(L), [l1[i], l2[i]]] end do:\n m := linalg[rowdim](m1);\n n := linalg[rowdim](m1);\n MN := linalg[matrix](m, n, []);\n \+ for i to m do for j to n do MN[i, j] := L[(i - 1)*n + j] od\n end \+ do:\n return evalm(MN)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 " " }{TEXT 434 18 "No. 25. Procedure " }{TEXT 471 13 "type/dfmatrix" } {TEXT 472 73 " checks if a matrix is of type 'dfmatrix', that is, over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 497 "`type/dfmatr ix`:=proc(m::anything) local mm;\noptions `Copyright (c) 1995-2008 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: December 20, 2007`;\n############################# ################\nif not type(m,matrix) and not type(m,list(matrix)) t hen return false end if:\nif type(m,matrix) then \n return type(conv ert(m,mlist),\n list(list(\{cliscalar,clibasmon,climon,clipol ynom,numeric,symbol,algebraic\})))\nelse\n return false\nend if:\nen d proc:\n" }}{PARA 0 "" 0 "" {TEXT 477 79 "In this version we define a ll ampersand operators as global in Clifford:-setup:" }{TEXT -1 1 "\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2305 "`&c`:=proc() local NP,ARGS,co B,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995-2008 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: December 20, 2007`;\n############################## ###############\n#######################################\n### Works wh en &c[''K''] or &c[''-K''] is entered and K is a matrix\n############# ##########################\nflagdec:=true:\nif type(op(procname),proce dure) then\n if type([args],listlist) then\n if type(op(args),a rray) 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 f ollowing:\");\n return 'procname(args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n lname:=`B`:\n ARGS:=[args]: \n flagdec:=false:\n end if;\nelse lname:=op(procname);\n \+ ARGS:=[args];\n if type(lname,`&*`(numeric,name)) then\n c oB:=op(select(type,\{op(lname)\},numeric));\n nameB:=op(select (type,\{op(lname)\},name));\n else\n coB:=1:\n nam eB:=lname:\n end if;\n flagdec:=false:\n end if;\n########### ############################\ndecindex:=proc() local ARGS,coB,nameB;gl obal B;\nif type([args],listlist) then\n if type(op(args),function) \+ then\n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0 ,op(args)));\n if type(nameB,`&*`(numeric,name)) then\n c oB:=op(select(type,\{op(nameB)\},numeric));\n nameB:=op(select (type,\{op(nameB)\},name));\n end if;\n elif type(op(args),`&* `(numeric,function)) then\n nameB:=\{op(op(args))\}:\n coB:= op(select(type,nameB,numeric));\n nameB:=op(select(type,nameB,fun ction));\n ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \"unable to determine index or wrong index, use name in do uble quotes as in &c[''B''] or &c[''-B'']\"\n end if;\nelif\n typ e([args],list) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #defau lt name \nelse\n error \"cannot determine arguments and/or index fro m arguments\"\n end if;\nreturn coB,nameB,[ARGS];\nend proc:\n######## #############################\nif flagdec then \n coB,nameB,ARGS:=de cindex(args);\n lname:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif memb er(0,ARGS) then return 0 end if;\nif NP <=1 then return op(ARGS) end i f;\nreturn cmul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2381 "`&cQ`:=proc() local NP,ARGS,coB,nameB,lname,de cindex,flagdec;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2007`;\n############################################# \n#######################################\n### Works when &cQ[''K''] o r &cQ[''-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 &cQ[''B''] or & cQ[''-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 fl agdec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args ];\n if type(lname,`&*`(numeric,name)) then\n coB:=op(sele ct(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op( lname)\},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;\ni f type([args],listlist) then\n if type(op(args),function) then\n \+ ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args)) );\n if type(nameB,`&*`(numeric,name)) then\n coB:=op(sel ect(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op (nameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric, function)) 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 erro r \"unable to determine index from or wrong index, use name in double \+ quotes as in &cQ[''B''] or &cQ[''-B'']\"\n end if;\nelif\n type([a rgs],list) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default n ame \nelse\n error \"cannot determine arguments and/or index from ar guments\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n############# ########################\nif flagdec then \n coB,nameB,ARGS:=decinde x(args);\n lname:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0, ARGS) then return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nr eturn cmul[eval(lname)](op(ARGS));\n#return cmulQ[eval(lname)](op(ARGS )); ###Causes an error in `&cQ` \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1856 "`&cQm`:=proc() local ARGS,lname,NP,coB,nameB,decind ex;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2007`;\n#############################################\n########### ############################\nif type([args],listlist) then\n if typ e(op(args),array) then\n WARNING(\"enclose index in double quotes as in &cQm[''B''] or &cQm[''-B''] when B has been assigned a matrix t o avoid the following:\");\n return ('procname(args)');\n end i f;\nend if;\n#######################################\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if \+ type(op(args),function) then\n ARGS:=op(op(args));\n coB:=1: \n nameB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric ,name)) then\n coB:=op(select(type,\{op(nameB)\},numeric));\n \+ nameB:=op(select(type,\{op(nameB)\},name));\n end if;\n \+ elif type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(o p(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 \"unable to determine index or wro ng index type for &cQm, try enclosing name of the index in double quot es as in &cQm[''B''] or &cQm[''-B'']\"\n end if;\nelif\n type([arg s],list) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default nam e \nelse\n error \"cannot determine arguments and/or index\"\nend if ;\nreturn coB,nameB,[ARGS];\nend proc:\n############################## #######\ncoB,nameB,ARGS:=decindex(args);\nlname:=coB*nameB:\n NP:=nop s(ARGS);\n if member(0,ARGS) then return 0 end if;\n if NP <=1 then \+ \n return op(ARGS)\n elif NP = 2 then \n return rmulm(eval(AR GS[1]),eval(ARGS[2]),cmulQ,lname) \n else\n error \"only two argu ments and index are allowed\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2448 "`&cm`:=proc() local NP,ARGS,coB,nameB,lname,de cindex,flagdec;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2007`;\n############################################# \n#######################################\n### Works when &cm[''K''] o r &cm[''-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 &cm[''B''] or & cm[''-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 \+ flagdec:=false:\n end if;\nelse lname:=op(procname);\n ARGS :=[args];\n if type(lname,`&*`(numeric,name)) then\n coB:= op(select(type,\{op(lname)\},numeric));\n nameB:=op(select(typ e,\{op(lname)\},name));\n else\n coB:=1:\n nameB:= lname:\n end if;\n flagdec:=false:\nend if;\n################ #######################\ndecindex:=proc() local ARGS,coB,nameB;global \+ B;\nif type([args],listlist) then\n if type(op(args),function) then \n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op( args)));\n if type(nameB,`&*`(numeric,name)) then\n coB:= op(select(type,\{op(nameB)\},numeric));\n nameB:=op(select(typ e,\{op(nameB)\},name));\n end if;\n elif type(op(args),`&*`(nu meric,function)) then\n nameB:=\{op(op(args))\}:\n coB:=op(s elect(type,nameB,numeric));\n nameB:=op(select(type,nameB,functio n));\n ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n \+ error \"unable to determine index or wrong index: use name in double quotes as in &cm[''B''] or &cm[''-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\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n########################### ##########\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n l name:=coB*nameB;\n end if;\n#return (coB,nameB,lname,ARGS);\nNP:=nops( ARGS);\n if member(0,ARGS) then return 0 end if;\n if NP <=1 then \n return op(ARGS)\n elif NP = 2 then \n return rmulm(eval(ARGS [1]),eval(ARGS[2]),cmul,lname) \n else\n error \"only two argumen ts and index are allowed\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 233 "`&q`:=proc()\noptions `Copyright (c) 1995-2008 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: December 20, 2007`;\n############################# ################\nreturn qmul(args) \nend proc:\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 466 "`&qm`:=proc() local NP: \noptions `Copyright (c) 1 995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: December 20, 2007`;\n################# ############################\n NP:=nops([args]);\n if member(0,[args ]) then return 0 end if;\n if NP <=1 then \n return args\n elif \+ NP = 2 then \n return rmulm(eval(args[1]),eval(args[2]),qmul) \n \+ else\n error \"only two arguments are allowed in &qm\"\n end if; \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 350 "`&om`:=proc()\nop tions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: December 20, 200 7`;\n#############################################\nif not assigned(Oc tonion) then\n error \"package 'Octonion' must be loaded first\"\nen d if;\nreturn subs(Id=1,rmulm(args,Octonion:-omul))\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1848 "`&rm`:=proc() local ARGS,lname,NP ,coB,nameB,decindex;\noptions `Copyright (c) 1995-2008 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: December 20, 2007`;\n######################################### ####\n#######################################\nif type([args],listlist ) then\n if type(op(args),array) then\n WARNING(\"enclose index in double quotes as in &rm[''B''] or &rm[''-B''] when B has been assi gned a matrix to avoid the following:\");\n return 'procname(args )';\n end if;\nend if;\n#######################################\ndec index:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if type(op(args),function) then\n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n if type(nameB ,`&*`(numeric,name)) then\n coB:=op(select(type,\{op(nameB)\}, numeric));\n nameB:=op(select(type,\{op(nameB)\},name));\n \+ end if;\n elif type(op(args),`&*`(numeric,function)) 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 \"unable to determin e index or wrong index type for &rm, try enclosing name of the index i n double quotes as in &rm[''B''] or &rm[''-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 inde x\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n################### ##################\ncoB,nameB,ARGS:=decindex(args);\nlname:=coB*nameB: \n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 end if;\n if N P <=1 then \n return op(ARGS)\n elif NP = 2 then \n return rm ulm(eval(ARGS[1]),eval(ARGS[2]),`&r`,lname) \n else\n error \"onl y two arguments and index are allowed\"\n end if;\n end proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 42 "`&w`:=proc() return wedge(args) end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 467 "`&wm`:=proc() local NP : \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\n NP:=nops([ args]);\n if member(0,[args]) then return 0 end if;\n if NP <=1 then \n return args\n elif NP = 2 then \n return rmulm(eval(args[ 1]),eval(args[2]),wedge) \n else\n error \"only two arguments are allowed in &wm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 117 "#################################################### \nend proc: ###<< " 0 "" {MPLTEXT 1 0 8 "libname;" }}{PARA 11 "" 1 " " {XPPMATH 20 "6&Q7C:\\Maple11/Cliffordlib6\"Q/C:\\Maple11/libF$Q1C:\\ Maple11/SPlibF$Q-C:\\laylinalgF$" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 70 "#march('delete',libname[1],Clifford);\n#march('create ',libname[1],500);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "libna me[1];" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\Maple11/Cliffordlib6\" " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford'):\n " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "march('listdir',libname [1]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&QAC:\\Maple11/Cliffordlib \\maple.lib6\"7(\"%2?\"#7\"#?\"#:\"#6\"#YQ)WRITABLEF&\"\"!" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 59 "Let's add library files to the main libra ry in libname[1]:\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 455 "mar ch('add',libname[1],`C:\\\\Maple11/Clifforddata/matrealL.m`,`matrealL. m`);\nmarch('add',libname[1],`C:\\\\Maple11/Clifforddata/matrealR.m`,` matrealR.m`);\nmarch('add',libname[1],`C:\\\\Maple11/Clifforddata/matc ompL.m`,`matcompL.m`);\nmarch('add',libname[1],`C:\\\\Maple11/Clifford data/matcompR.m`,`matcompR.m`);\nmarch('add',libname[1],`C:\\\\Maple11 /Clifforddata/matquatL.m`,`matquatL.m`);\nmarch('add',libname[1],`C:\\ \\Maple11/Clifforddata/matquatR.m`,`matquatR.m`);" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matrealL.m\" already in archive, skippi ng\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matrealR.m\" al ready in archive, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, \+ member \"matcompL.m\" already in archive, skipping\n" }}{PARA 7 "" 1 " " {TEXT -1 58 "Warning, member \"matcompR.m\" already in archive, skip ping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matquatL.m\" \+ already in archive, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning , member \"matquatR.m\" already in archive, skipping\n" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 48 "and verify that indeed addition has taken place:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealL );" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"*\"\"!7#7$F&\"\"(7#7$\" \"$\"\"#7#7$\"\"&\"\"%7#7$\"\"\"F47#7$F-F-7#7$F1F-7#7$F4F)7#7$F&\"\"'7 #7$F4\"\")7#7$F0F,7#7$F,F,7#7$F-F&7#7$F,F47#7$F1F17#7$F&F@7#7$F-F47#7$ F1F,7#7$F@F&" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(mat realR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"*\"\"!7#7$F&\"\"(7# 7$\"\"$\"\"#7#7$\"\"&\"\"%7#7$\"\"\"F47#7$F-F-7#7$F1F-7#7$F4F)7#7$F&\" \"'7#7$F4\"\")7#7$F0F,7#7$F,F,7#7$F-F&7#7$F,F47#7$F1F17#7$F&F@7#7$F-F4 7#7$F1F,7#7$F@F&" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices (matcompL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"%\"\"\"7#7$\"\" )F&7#7$\"\"$\"\"!7#7$F,F%7#7$\"\"&\"\"#7#7$F-\"\"*7#7$F%F27#7$F&\"\"'7 #7$F-F27#7$F;F,7#7$F3F,7#7$\"\"(F-7#7$F&F37#7$F3FD" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"%\"\"\"7#7$\"\")F&7#7$\"\"$\"\"!7#7$F,F%7#7$\" \"&\"\"#7#7$F-\"\"*7#7$F%F27#7$F&\"\"'7#7$F-F27#7$F;F,7#7$F3F,7#7$\"\" (F-7#7$F&F37#7$F3FD" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indi ces(matquatL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"'\"\"#7#7$\" \"&\"\"\"7#7$\"\"%\"\"!7#7$F&F)7#7$F&F-7#7$F*F-7#7$F%F.7#7$F*F)7#7$\" \"(F&7#7$F.F-7#7$\"\"$F%7#7$F@F)7#7$F%F*7#7$F.F&7#7$F;F*7#7$F&F%7#7$F. F@7#7$F)F.7#7$F*F@" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indic es(matquatR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"'\"\"#7#7$\" \"&\"\"\"7#7$\"\"%\"\"!7#7$F&F)7#7$F&F-7#7$F*F-7#7$F%F.7#7$F*F)7#7$\" \"(F&7#7$F.F-7#7$\"\"$F%7#7$F@F)7#7$F%F*7#7$F.F&7#7$F;F*7#7$F&F%7#7$F. F@7#7$F)F.7#7$F*F@" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 258 "" 0 "" {TEXT -1 989 "Last revised: December 20, 2007 \n\nNOTES:\n\n1. The table name, e.g., Clifford, and the file name, e. g., Clifford.m must be the same.\n2. March commands useful in creating and viewing library file (issue in DOS window):\n\nC:\\Maple10>bin.wn t\\march -c Cliffordlib 20 - creates library in a existing empty di rectory \\Cliffordlib\nC:\\Maple10>bin.wnt\\march -l Cliffordlib - li st all entries in the library Cliffordlib\nC:\\Maple10>bin.wnt\\march \+ -l Cliffordlib > list.txt - list all entries in the library Cliffordl ib and write them into file list.txt\nC:\\Maple10>bin.wnt\\march -d Cl iffordlib Clifford.m - delete Clifford.m from the library Cliffordlib \n\n3. Global variable savelibname is empty, but savelib() automatical ly assigns libname[1] to savelibname for the purpose of saving package there with the command savelib().\n4. Maple initialization file maple .ini contains libname augmented by the path and the directory name \\C liffordlib where the Clifford library with Clifford.m will be located. " }{MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} }{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 198 "################################################## #####\n###end module:\n###march('create',Cliffordlib,500);\n###savelib (Clifford,`Clifford.m`):\n############################################ ############" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 "restart:wit h(Clifford);" }}{PARA 12 "" 1 "" {XPPMATH 20 "6#7`p%#&mG%+BsignatureG% -CLIFFORD_ENVG%'KfieldG%#LCG%$LCQG%#RCG%$RCQG%)RHnumberG%*adfmatrixG%) all_sigsG%+beta_minusG%*beta_plusG%'buildmG%(bygradeG%)c_conjugG%'cbas isG%*cdfmatrixG%%cexpG%&cexpQG%%cinvG%,clibilinearG%+clicollectG%(clid ataG%*clilinearG%+climinpolyG%)cliparseG%*cliremoveG%)clisolveG%(cliso rtG%)clitermsG%%cmulG%(cmulNUMG%&cmulQG%'cmulRSG%(cmulgenG%(cocycleG%2 commutingelementsG%,conjugationG%*ddfmatrixG%,diagonalizeG%*displayidG %(extractG%1factoridempotentG%)find1strG%*findbasisG%)gradeinvG%%initG %/isVahlenmatrixG%*isproductG%,makealiasesG%.makeclibasmonG%)matKreprG %)maxgradeG%)maxindexG%*mdfmatrixG%-minimalidealG%$ordG%)permsignG%*ps eudodetG%)q_conjugG%)qdisplayG%%qinvG%%qmulG%&qnormG%-rd_clibasmonG%*r d_climonG%.rd_clipolynomG%(reorderG%*reversionG%&rmulmG%&rot3dG%+scala rpartG%%sexpG%2specify_constantsG%-spinorKbasisG%,spinorKreprG%+square modfG%0subs_clipolynomG%+useproductG%+vectorpartG%(versionG%&wedgeG%%w expG" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "22 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }